diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index f8fded7ca8..04d60d91c3 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -22,25 +22,25 @@ Added in OpenFAST dev --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name Example Value ============================================= ==== =============== ======================================================================================================================================================================================================== -IfW driver 6 [separator line] ===================== File Conversion Options ================================= +IfW driver 6 [sep. line] ===================== File Conversion Options ================================= IfW driver 7 WrHAWC false WrHAWC - Convert all data to HAWC2 format? (flag) IfW driver 8 WrBladed false WrBladed - Convert all data to Bladed format? (flag) IfW driver 9 WrVTK false WrVTK - Convert all data to VTK format? (flag) -InflowWind 7 VFlowAng 0 VFlowAng - Upflow angle (degrees) (not used for native Bladed format WindType=7) -SubDyn 8 ExtraMom False ExtraMoment - Include extra moment from lever arm at interface in interface reactions. -SubDyn 15 GuyanDampMod 0 GuyanDampMod - Guyan damping {0=none, 1=Rayleigh Damping, 2=user specified 6x6 matrix} -SubDyn 16 RayleighDamp 0.001, 0.003 RayleighDamp - Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] -SubDyn 17 GuyanDampSize 6 GuyanDampSize - Guyan damping matrix size (square, 6x6) [only if GuyanDampMod=2] -SubDyn 18 GuyanDampMat 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 -SubDyn -23 GuyanDampMat 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 -SubDyn na CablesSection -------------------------- CABLE PROPERTIES ------------------------------------- -SubDyn na CablesSection 0 NCablePropSets - Number of cable cable properties -SubDyn na CablesSection PropSetID EA MatDens T0 -SubDyn na CablesSection (-) (N) (kg/m) (N) -SubDyn na RigidSection ---------------------- RIGID LINK PROPERTIES ------------------------------------ -SubDyn na RigidSection 0 NRigidPropSets - Number of rigid link properties -SubDyn na RigidSection PropSetID MatDens -SubDyn na RigidSection (-) (kg/m) +InflowWind 7 VFlowAng 0 VFlowAng - Upflow angle (degrees) (not used for native Bladed format WindType=7) +SubDyn 8 ExtraMom False ExtraMoment - Include extra moment from lever arm at interface in interface reactions. +SubDyn 15 GuyanDampMod 0 GuyanDampMod - Guyan damping {0=none, 1=Rayleigh Damping, 2=user specified 6x6 matrix} +SubDyn 16 RayleighDamp 0.001, 0.003 RayleighDamp - Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] +SubDyn 17 GuyanDampSize 6 GuyanDampSize - Guyan damping matrix size (square, 6x6) [only if GuyanDampMod=2] +SubDyn 18 GuyanDampMat 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 +SubDyn -23 GuyanDampMat 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 0.0000e+00 +SubDyn na CablesSection -------------------------- CABLE PROPERTIES ------------------------------------- +SubDyn na CablesSection 0 NCablePropSets - Number of cable cable properties +SubDyn na CablesSection PropSetID EA MatDens T0 +SubDyn na CablesSection (-) (N) (kg/m) (N) +SubDyn na RigidSection ---------------------- RIGID LINK PROPERTIES ------------------------------------ +SubDyn na RigidSection 0 NRigidPropSets - Number of rigid link properties +SubDyn na RigidSection PropSetID MatDens +SubDyn na RigidSection (-) (kg/m) ============================================= ==== =============== ======================================================================================================================================================================================================== diff --git a/docs/source/user/subdyn/input_files.rst b/docs/source/user/subdyn/input_files.rst index a0dbfd7b83..cdac52e42e 100644 --- a/docs/source/user/subdyn/input_files.rst +++ b/docs/source/user/subdyn/input_files.rst @@ -593,6 +593,9 @@ to align properly, the width specification should match. For example: | "ES11.4" OutFmt | "A11" OutSFmt. + +.. _SD_Member_Output: + Member Output List ~~~~~~~~~~~~~~~~~~ diff --git a/docs/source/user/subdyn/theory.rst b/docs/source/user/subdyn/theory.rst index 4bfbd17650..1d69ec2c80 100644 --- a/docs/source/user/subdyn/theory.rst +++ b/docs/source/user/subdyn/theory.rst @@ -216,7 +216,7 @@ are the start and end joints of the member (or nodes of the element of interest) If :math:`{X_E = X_S}` and :math:`{Z_E = Z_S}`, the :math:`{[ \mathbf{D_c} ]}` matrix can be found as follows: -if :math:`{Z_E < Z_S}` then +if :math:`{Z_E >= Z_S}` then .. math:: :label: Dc_spec1 @@ -1305,7 +1305,7 @@ DOFs). For this reason, a C-B methodology was used to recharacterize the substructure finite-element model into a reduced DOF model that maintains the fundamental low-frequency response modes of the structure. With the C-B method, the DOFs of the substructure can be reduced to -about 10 (user defined, see also Section :ref:`CBguide`). This system reduction method +about 10 (user defined, see also Section :numref:`CBguide`). This system reduction method was first introduced by :cite:`hurty1964` and later expanded by :cite:`craig1968`. @@ -1647,6 +1647,17 @@ substructure response at each time step can then be obtained by using the state-space formulation discussed in the next section. +Floating or fixed-bottom structure +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Different formulations are used in SubDyn depending if the structure is "fixed-bottom" or "floating". + +The structure is considered to be "floating" if there is no reaction nodes. + +The structure is considered to be "fixed-bottom" in any other case. + + + .. _SD_Loads: Loads @@ -1694,6 +1705,16 @@ The Guyan TP force, :math:`\tilde{F}_{TP}`, and the CB force, :math:`F_m`, given +.. _SD_Rotated Loads: + +Rotation of loads for floating +^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +In the floating case, the loads acting on the FEM degrees of freedom need to be rotated to the body frame. In the current implementation, this is done when evaluating :math:`F_{L}` for the time evolution of the CB degrees of freedom, and the determination of the static improvement displacements. +More details on this special case is found in section :numref:`SD_summary`. + + + .. _SD_ExtraMoment: Extra moment from deflection @@ -1714,7 +1735,6 @@ First, a reference undeflected position of the structure is defined, with two po Illustration for the additional moment occurring due to the distance between the deflected position of the structure and the reference position used for the finite element representation. For simplicity, the loads are assumed to act at the Guyan position instead of the true deflected position. -The structure is considered "fixed" at the sea bed if at least one reaction node satisfies one of these two conditions: the 4 degrees of freedom accounting for the x-y translation and rotation are fixed at the sea bed, or, an additional stiffness matrix is given via an SSI input file (see :numref:`sd_ssi_inputfile`). Second, the external loads are assumed to be applied on the "Guyan" deflected structure, instead of the fully deflected structure. The Craig-Bampton displacements are omitted to avoid the non-linear dependency between the input loads and the Craig-Bampton states. With this assumption, the external loads at the Guyan position are mapped to the reference position. @@ -2001,20 +2021,6 @@ By examining Eq. :eq:`main4` and Eq. :eq:`FTPtilde`, the force is extracted from Inserting the expression of :math:`\ddot{q}_m` into :math:`F_{TP}` leads to: -.. F_{TP} =& \tilde{M}_{BB}\ddot{U}_{TP} - + \tilde{M}_{Bm} \left[ - \Phi_m^T(F_L + F_{L,g}) - - \tilde{M}_{mB} \ddot{U}_{TP} - - \tilde{C}_{mB} \dot{U}_{TP} - - \tilde{C}_{mm} \dot{q}_m - - \tilde{K}_{mm} q_m - \right] - \nonumber\\ - &+ \tilde{C}_{BB}\dot{U}_{TP} + \tilde{C}_{Bm} \dot{q}_m - + \tilde{K}_{BB} U_{TP} - - T_I^T \left(\bar{F}_{HDR} + \bar{F}_{Rg} + \bar{\Phi}_R(F_{L,e} + F_{L,g}) \right) - \nonumber\\ - .. math:: :label: FTP3 :nowrap: @@ -2102,7 +2108,7 @@ From the CB coordinate transformation (Eq. :eq:`CB3`), and the link between boun ,\qquad \ddot{\bar{U}}_L = \bar{\Phi}_R \ddot{\bar{U}}_R + \Phi_m \ddot{q}_m -Using the expression of :math:`\ddot{q}m` from Eq. :eq:`ddotqm`, the internal accelerations are: +Using the expression of :math:`\ddot{q}_m` from Eq. :eq:`ddotqm`, the internal accelerations are: .. math:: :label: y2internalacc @@ -2114,6 +2120,7 @@ Using the expression of :math:`\ddot{q}m` from Eq. :eq:`ddotqm`, the internal ac - \tilde{K}_{mm} q_m \right] +In the floating case, the Guyan part of the motion are replaced by the analytical rigid body motion (se details in section :numref:`SD_summary`). The output equation for :math:`y_2`: can then be written as: @@ -2157,6 +2164,7 @@ where The expression for :math:`F_{Y2}` will be modified by the SIM method and Eq. :eq:`bigY2sim` is used instead. + .. _sim: .. _SD_SIM: @@ -2186,7 +2194,7 @@ with C-B modes (:math:`U_{L0m}`), as cast in :eq:`SIM` : .. math:: :label: SIM - U_L = \hat{U}_L + U_{L0} - U_{L0m} = \underbrace{\Phi_R U_R + \Phi_m q_m}_{\hat{U}_L} + \underbrace{\Phi_L q_{L0}}_{U_{L0}} - \underbrace{\Phi_m q_{m0}}_{U_{L0m}} + U_L = \hat{U}_L + U_{L,\text{SIM}} =\hat{U}+ \underbrace{U_{L0} - U_{L0m}}_{U_{L,\text{SIM}}} = \underbrace{\Phi_R U_R + \Phi_m q_m}_{\hat{U}_L} + \underbrace{\Phi_L q_{L0}}_{U_{L0}} - \underbrace{\Phi_m q_{m0}}_{U_{L0m}} .. where the expression for :math:`U_{L0}` and :math:`U_{L0m}` will be derived in the next paragraph. @@ -2234,12 +2242,13 @@ Similarly: with :math:`\tilde{F}_m =\Phi_m^T(F_{L,e} + F_{L,g})`. Note that: :math:`{ \dot{U}_{L0} = \dot{q}_{L0} = \dot{U}_{L0m} = \dot{q}_{m0} =0 }` and :math:`{ \ddot{U}_{L0} = \ddot{q}_{L0} = \ddot{U}_{L0m} = \ddot{q}_{m0} =0 }`. +In the floating case the loads :math:`F_L` is rotated to the body coordinate system when "ExtraMoment" is True (see :numref:`SD_summary` for more details). + The dynamic component :math:`{ \hat{U} = \begin{bmatrix} \hat{U}_R \\ \hat{U}_R \end{bmatrix} }` is calculated following the usual procedure described in :numref:`SSformulation` to :numref:`TimeIntegration`. For example, states are still calculated and integrated as in Eq. :eq:`state_eq`, and the output to ElastoDyn, i.e., the reaction provided by the substructure at the TP interface, is also calculated as it was done previously in Eqs. :eq:`smally1` and :eq:`bigY1`. - However, the state-space formulation is slightly modified (simply adding the contribution :math:`U_{L0}-U_{L0m}` to :math:`F_{Y2}` when computing the outputs to HydroDyn as: @@ -2255,7 +2264,7 @@ when computing the outputs to HydroDyn as: \ddot{U}_L \\ \end{bmatrix} = \begin{bmatrix} \bar{U}_R \\ - \hat{U}_L + \boldsymbol{U_{L0} - U_{L0m}} \\ + \hat{U}_L + \boldsymbol{U_{L,\text{SIM}}} \\ \dot{\bar{U}}_R \\ \dot{U}_L \\ \ddot{\bar{U}}_R \\ @@ -2268,7 +2277,7 @@ The array :math:`F_{Y2}` from Eq. :eq:`bigY2` is now defined as follows: F_{Y2} &= \begin{bmatrix} 0 \\ - \boldsymbol{U_{L0} - U_{L0m}} \\ + \boldsymbol{U_{L,\text{SIM}}} \\ 0 \\ 0 \\ 0 \\ @@ -2276,70 +2285,89 @@ The array :math:`F_{Y2}` from Eq. :eq:`bigY2` is now defined as follows: \end{bmatrix} -Finally, the element forces can be calculated as: -.. math:: :label: el_loads_sim - \text{Element Inertia load:} ~~ F_I^e &= [m] \ddot{U}_e - - \text{Element Static load:} ~~ F_S^e &= [k] U_e = [k] \left[ \hat{U}_e + U_{L0,e} - U_{L0m,e} \right] - -with the element node DOFs expressed as: +Outputs and Time Integration +---------------------------- -.. math:: :label: Uesim - U_e = \hat{U}_e + U_{L0,e} - U_{L0m,e} -where the SIM decomposition is still used with :math:`\hat{U}_e` denoting the -time-varying components of the elements nodes' displacements, and :math:`U_{L0,e}` and :math:`U_{L0m,e}` are -derived from the parent :math:`U_{L0}` and :math:`U_{L0m}` arrays of displacements, respectively. +.. _SD_MemberForce: +Nodal Loads Calculation +~~~~~~~~~~~~~~~~~~~~~~~~ +We start by introducing how element loads are computed, before detailling how nodal loads are obtained. +**Element Loads**: +SubDyn calculates 12-vector element loads in the element coordinate system using the global motion of the element: +.. math:: :label: el_loads + \text{Element Inertia load:} ~~ F_{I,12}^e &= [D_{c,12}]^T [m] \ddot{U}_{e,12} + + \text{Element Stiffness load:} ~~ F_{S,12}^e &= [D_{c,12}]^T [k] \left[ \hat{U}_e + U_{L,\text{SIM}} \right]_{12} + +where [*k*] and [*m*] are element stiffness and mass matrices expressed in the global frame, +:math:`D_{c,12}` is a 12x12 matrix of DCM for a given element, +the subscript 12 indicates that the 12 degrees of freedom of the element are considered, +and :math:`U_e` and :math:`\ddot{U}_e` are element nodal deflections and accelerations respectively, +which can be obtained from Eq. :eq:`y2` and may contain the static displacement contribution :math:`U_{L,\text{SIM}}`. There is no good way to quantify the damping forces for each element, so +the element damping forces are not calculated. +**Nodal loads** +For a given element node, the loads are the 6-vector with index 1-6 or 7-12 for the first or second node respectively. By convention, the 6-vector is multiplied by -1 for the first node and +1 for the second node of the element: +.. math:: :label: nd_loads -Outputs and Time Integration ----------------------------- + F_{6}^{n_1} = - F_{12}^e(1:6) + ,\quad + F_{6}^{n_2} = + F_{12}^e(7:12) +The above applies for the inertial and stiffness loads. + +**Member nodal loads requested by the user** -Member Force Calculation -~~~~~~~~~~~~~~~~~~~~~~~~ +The user can output nodal loads for a set of members (see :numref:`SD_Member_Output`). -SubDyn can also calculate member forces by starting from the forces -computed at the nodes of the elements that are contained in the member -as: +For the user requested member nodal outputs, the loads are either: 1) the appropriate 6-vector at the member end nodes, or, 2) the average of the 6-vectors from the two elements surrounding a node for the nodes in the middle of a member. When averaging is done, the 12-vectors of both surrounding elements are expressed using the DCM of the member where outputs are requested. -.. math:: :label: el_loads - \text{Element Inertia load:} ~~ F_I^e = [m] \ddot{U}_e - - \text{Element Static load:} ~~ F_S^e = [k] U_e - -where [*k*] and [*m*] are element stiffness and mass matrices, respectively. And -:math:`U_e` and :math:`\ddot{U}_e` are element nodal deflections and accelerations respectively, -which can be obtained from Eq. :eq:`y2`. +**"AllOuts" nodal loads** -There is no good way to quantify the damping forces for each element, so -the element damping forces are not calculated. +For "AllOuts" nodal outputs, the loads are not averaged and the 6-vector (with the appropriate signs) are directly written to file. + +**Reaction nodal loads** +(See :numref:`SD_Reaction`) + + + + +.. _SD_Reaction: Reaction Calculation ~~~~~~~~~~~~~~~~~~~~ -The reactions at the base of the structure are the member forces at the -base nodes. These are usually provided in member local reference frames. +The reactions at the base of the structure are the nodal loads at the +base nodes. + + + + Additionally, the user may request an overall reaction :math:`\overrightarrow{R}` (six forces and moments) lumped at the center of the substructure (tower centerline) and mudline, i.e., at the reference point (0,0,-**WtrDpth**) in the global reference frame, with -**WtrDpth** denoting the water depth. :math:`\overrightarrow{R}` is a -six-element array that can be calculated in matrix form as follows: +**WtrDpth** denoting the water depth. + +To obtain this overall reaction, the forces and moments at the :math:`N_\text{React}` restrained +nodes are expressed in the global coordinate frame and gathered into the vector :math:`F_{\text{React}}`, which is a (6*N\ :sub:`React`) array. +For a given reaction node, the 6-vector of loads is obtained by summing the nodal load contributions from all the elements connected to that node expressed in the global frame (no account of the sign is done here), and subtracting the external loads (:math:`F_{HDR}`) applied on this node. +The loads from all nodes, :math:`F_{\text{React}}`, are then rigidly-transferred to :math:`(0,0,-\text{WtrDpth})` to obtain the overall six-element array :math:`\overrightarrow{R}`: .. math:: :label: reaction @@ -2349,10 +2377,7 @@ six-element array that can be calculated in matrix form as follows: M_{Z} \\ \end{bmatrix} = T_{\text{React}} F_{\text{React}} - -where :math:`F_{\text{React}}` is a (6*N\ :sub:`React`) array -containing the forces and moments at the *N\ :sub:`react`* restrained -nodes in the global coordinate frame, and :math:`T_{\text{React}}` is a +where :math:`T_{\text{React}}` is a ( :math:`{6×6 N_{\text{React}}}` ) matrix, as follows: .. math:: :label: Treact @@ -2367,12 +2392,7 @@ nodes in the global coordinate frame, and :math:`T_{\text{React}}` is a \end{bmatrix} where :math:`{X_i,~Y_i}`, and :math:`Z_i` (:math:`{i = 1 .. N_{\text{React}}}`) are coordinates of -the boundary nodes with respect to the reference point. For each element -with a restrained node, :math:`F_{\text{React}}` is calculated starting -from :math:`F_S^e` --- see Eq. :eq:`el_loads` --- subtracting out the contributions of gravity --- :math:`F_G`, see Eq. :eq:`FG` -and hydrodynamic loads (:math:`F_{HDR}`) at the restrained node. No direct -element-level inertial or damping effect is therefore included in the -reaction calculation. +the boundary nodes with respect to the reference point. @@ -2417,8 +2437,218 @@ For more information, consult any numerical methods reference, e.g., +.. _SD_summary: + +Summary of the formulation implemented +-------------------------------------- + +This section summarizes the equations currently implemented in SubDyn, with the distinction between floating and fixed bottom cases. +We introduce the operators :math:`R_{g2b}` (rotation global to body) and :math:`R_{b2g}` (rotation body to global), which act on the array on the right of the operator. The operators rotate the individual 3-vectors present in an array. When applied to load vectors (e.g. :math:`F_L`), the rotations actually is applied to the loads on the full system, before the loads are transferred to the reduced system by use of the :math:`\boldsymbol{T}` matrix. + + +State equation +~~~~~~~~~~~~~~ + +**Fixed-bottom case** + +.. math:: + :nowrap: + + \begin{align} + \ddot{q}_m = \Phi_m^T F_L + - \tilde{M}_{mB} \ddot{U}_{TP} + - \tilde{C}_{mm} \dot{q}_m + - \tilde{K}_{mm} q_m + \end{align} + +Note: :math:`F_L` contains the "extra moment" if user-requested. + +**Floating case without "Extra Moment"** + +.. math:: + :nowrap: + + \begin{align} + \ddot{q}_m = \Phi_m^T F_L + - \tilde{M}_{mB} R_{g2b} \ddot{U}_{TP} + - \tilde{C}_{mm} \dot{q}_m + - \tilde{K}_{mm} q_m + \end{align} + +Notes: :math:`F_L` *does not* contain the "extra moment". + + +**Floating case with "Extra Moment"** + +.. math:: + :nowrap: + + \begin{align} + \ddot{q}_m = \Phi_m^T R_{g2b} F_L + - \tilde{M}_{mB} R_{g2b} \ddot{U}_{TP} + - \tilde{C}_{mm} \dot{q}_m + - \tilde{K}_{mm} q_m + \end{align} + +Notes: :math:`F_L` *does not* contain the "extra moment". The (external + gravity) loads and the acceleration of the TP are rotated to the body coordinate system. + + +Output: interface reaction +~~~~~~~~~~~~~~~~~~~~~~~~~~ + +**Fixed bottom case** + +.. math:: + :nowrap: + + \begin{align} + -Y_1 =F_{TP,cpl} = + \begin{Bmatrix} + f_{TP,cpl} \\ + m_{TP,cpl} \\ + \end{Bmatrix} + & = + \left[ - \tilde{M}_{Bm}\tilde{K}_{mm} \right] q_m + +\left[- \tilde{M}_{Bm}\tilde{C}_{mm} \right] \dot{q}_m + \\ + &+\left[\tilde{K}_{BB} \right] U_{TP} + +\left[\tilde{C}_{BB} \right] \dot{U}_{TP} + +\left[\tilde{M}_{BB} -\tilde{M}_{Bm} \tilde{M}_{mB} \right] \ddot{U}_{TP} + \nonumber \\ + &+\left[\tilde{M}_{Bm}\Phi_m^T\right] F_L +\left[- T_I^T \bar{\Phi}_R^T \right] F_{L} + +\left[ -T_I^T \right] \bar{F}_R + \nonumber + \end{align} + +Note: :math:`F_L` and :math:`\bar{F}_R` contains the "extra moment" if user-requested. +If this is the case, the following additional term is added to the moment part of :math:`Y_1`, +:math:`m_{Y_1,\text{extra}}=u_{TP} \times f_{TP,cpl}`. + + + +**Floating case without "Extra moment"** + +.. math:: + :nowrap: + + \begin{align} + -Y_1 =F_{TP,cpl} =& + R_{b2g}\left[ - \tilde{M}_{Bm}\tilde{K}_{mm} \right] q_m + + R_{b2g}\left[- \tilde{M}_{Bm}\tilde{C}_{mm} \right] \dot{q}_m + \\ + &+\left[\tilde{K}_{BB} \right] U_{TP} + +\left[\tilde{C}_{BB} \right] \dot{U}_{TP} + +\left[\tilde{M}_{BB} -\tilde{M}_{Bm} \tilde{M}_{mB} \right] \ddot{U}_{TP} + \nonumber \\ + &+ R_{b2g}\left[\tilde{M}_{Bm}\Phi_m^T\right] F_L +\left[- T_I^T \bar{\Phi}_R^T \right] F_{L} + +\left[-T_I^T \right] \bar{F}_R + \nonumber + \end{align} + +Notes: 1) :math:`F_L` and :math:`\bar{F}_R` *do not* contain the "extra moment"; +2) The rotation :math:`R_{b2g}\tilde{M}_{Bm} \tilde{M}_{mB}R_{g2b}` is not carried out since it introduced stability issues. + +**Floating case with "Extra moment"** + +.. math:: + :nowrap: + + \begin{align} + -Y_1 =F_{TP,cpl} =& + R_{b2g}\left[ - \tilde{M}_{Bm}\tilde{K}_{mm} \right] q_m + + R_{b2g}\left[- \tilde{M}_{Bm}\tilde{C}_{mm} \right] \dot{q}_m + \\ + &+\left[\tilde{K}_{BB} \right] U_{TP} + +\left[\tilde{C}_{BB} \right] \dot{U}_{TP} + +\left[\tilde{M}_{BB} -\tilde{M}_{Bm} \tilde{M}_{mB} \right] \ddot{U}_{TP} + \nonumber \\ + &+ R_{b2g}\left[\tilde{M}_{Bm}\Phi_m^T\right] R_{g2b} F_L +\left[- T_I^T \bar{\Phi}_R^T \right] F_{L,\text{extra}} + +\left[-T_I^T \right] \bar{F}_{R,\text{extra}} + \nonumber + \end{align} + + +Notes: 1) :math:`F_{L,\text{extra}}` and :math:`F_{R,\text{extra}}` contain the "extra moment" in the Guyan contribution; 2) For the Craig-Bampton contribution, the loads are rotated to the body coordinate system using the operator :math:`R_{g2b}` (global to body); 3) The rotation :math:`R_{b2g}\tilde{M}_{Bm} \tilde{M}_{mB}R_{g2b}` is not carried out since it introduced stability issues. + +Output: nodal motions +~~~~~~~~~~~~~~~~~~~~~ + +**Fixed-bottom case** + +.. math:: :label: + + \bar{U}_R &= T_I U_{TP} + ,\qquad + \bar{U}_L = \bar{\Phi}_R \bar{U}_R + \Phi_m q_m + U_{L,\text{SIM}} + + \dot{\bar{U}}_R &= T_I \dot{U}_{TP} + ,\qquad + \dot{\bar{U}}_L = \bar{\Phi}_R \dot{\bar{U}}_R + \Phi_m \dot{q}_m + + \ddot{\bar{U}}_R &= T_I \ddot{U}_{TP} + ,\qquad + \ddot{\bar{U}}_L = \bar{\Phi}_R \ddot{\bar{U}}_R + \Phi_m\left[\Phi_m^T F_L + - \tilde{M}_{mB} \ddot{U}_{TP} + - \tilde{C}_{mm} \dot{q}_m + - \tilde{K}_{mm} q_m \right] + + +Note: :math:`F_L` contains the "extra moment" if user-requested. + + + + +**Floating case** + +.. math:: :label: + + \bar{U}_R &= U_{R,\text{rigid}} + ,\qquad + \bar{U}_L = U_{L,\text{rigid}} + 0\cdot R_{b2g} \left(\Phi_m q_m + U_{L,\text{SIM}}\right) + + \dot{\bar{U}}_R &= \dot{U}_{R,\text{rigid}} + ,\qquad + \dot{\bar{U}}_L = \dot{U}_{L,\text{rigid}} + R_{b2g} \Phi_m \dot{q}_m + + \ddot{\bar{U}}_R &= \ddot{U}_{R,\text{rigid}} + ,\qquad + \ddot{\bar{U}}_L = \ddot{U}_{L,\text{rigid}} + R_{b2g}\Phi_m\left[\Phi_m^T R_{g2b} F_L + - \tilde{M}_{mB} R_{g2b}\ddot{U}_{TP} + - \tilde{C}_{mm} \dot{q}_m + - \tilde{K}_{mm} q_m \right] + +where: 1) :math:`F_L` does not contain the extra moment, 2) the operator :math:`R_{g2b}` is only used on :math:`F_L` if ExtraMoment is True, 3) the elastic displacements were set to 0 for stability purposes (assuming that these are small) 4) the Guyan motion is computed using the exact rigid body motions. For a given node :math:`P`, located at the position :math:`r_{IP,0}` from the interface in the undisplaced configuration, the position (from the interface point), displacement, translational velocity and acceleration due to the rigid body motion are: + + +.. math:: + r_{IP} &= R_{b2g} r_{IP,0} + ,\quad + u_P = r_{IP} - r_{IP,0} + u_{TP} + ,\quad + + \dot{u}_P &= \dot{u}_{TP} + \omega_{TP} \times r_{IP} + ,\quad + \ddot{u}_P= \ddot{u}_{TP} + \dot{\omega}_{TP} \times r_{IP} + \omega_{TP} \times (\omega_{TP} \times r_{IP}) + +where :math:`\omega_{TP}` is the angular velocity at the transition piece. The small angle rotations, angular velocities and accelerations of each nodes, due to the rigid body rotation, are the same as the interface values, :math:`\theta_{TP}`, :math:`\omega_{TP}` and :math:`\dot{\omega}_{TP}`, so that: + +.. math:: + U_{P,\text{rigid}} = \{u_P \ ; \theta_{TP}\}^T + ,\quad + \dot{U}_{P,\text{rigid}} = \{\dot{u}_P \ ; \omega_{TP}\}^T + ,\quad + \ddot{U}_{P,\text{rigid}} = \{\ddot{u}_P \ ; \dot{\omega}_{TP}\}^T + +where :math:`P` is a point belonging to the R- or L-set of nodes. + + +Outputs to file: +~~~~~~~~~~~~~~~~ +**Motions**: nodal motions written to file are in global coordinates, and for the floating case they contain the elastic motion :math:`\bar{U}_L = U_{L,\text{rigid}} + \Phi_m q_m + U_{L,\text{SIM}}` (whereas these elastic motions are not returned to the glue code) +**Loads**: +Nodal loads are written to file in the element coordinate system. The procedure are the same for fixed-bottom and floating cases. diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index 8a80d2e5a1..c705e6aea8 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -67,8 +67,7 @@ MODULE SD_FEM ! Types of Static Improvement Methods INTEGER(IntKi), PARAMETER :: idSIM_None = 0 INTEGER(IntKi), PARAMETER :: idSIM_Full = 1 - INTEGER(IntKi), PARAMETER :: idSIM_GravOnly = 2 - INTEGER(IntKi) :: idSIM_Valid(3) = (/idSIM_None, idSIM_Full, idSIM_GravOnly /) + INTEGER(IntKi) :: idSIM_Valid(2) = (/idSIM_None, idSIM_Full/) ! Types of Guyan Damping INTEGER(IntKi), PARAMETER :: idGuyanDamp_None = 0 @@ -1029,11 +1028,10 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) CALL AllocAry( Init%K, p%nDOF, p%nDOF , 'Init%K', ErrStat2, ErrMsg2); if(Failed()) return; ! system stiffness matrix CALL AllocAry( Init%M, p%nDOF, p%nDOF , 'Init%M', ErrStat2, ErrMsg2); if(Failed()) return; ! system mass matrix - CALL AllocAry( Init%FG,p%nDOF, 'Init%FG', ErrStat2, ErrMsg2); if(Failed()) return; ! system gravity force vector - CALL AllocAry( p%FG_full, p%nDOF, 'p%FG_full', ErrStat2, ErrMsg2); if(Failed()) return; ! system gravity force vector + CALL AllocAry( p%FG, p%nDOF, 'p%FG' , ErrStat2, ErrMsg2); if(Failed()) return; ! system gravity force vector Init%K = 0.0_FEKi Init%M = 0.0_FEKi - Init%FG = 0.0_FEKi + p%FG = 0.0_FEKi ! loop over all elements, compute element matrices and assemble into global matrices DO i = 1, Init%NElem @@ -1044,7 +1042,7 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) ! --- Assembly in global unconstrained system IDOF = p%ElemsDOF(1:12, i) - Init%FG( IDOF ) = Init%FG( IDOF ) + FGe(1:12)+ FCe(1:12) ! Note: gravity and pretension cable forces + p%FG ( IDOF ) = p%FG( IDOF ) + FGe(1:12)+ FCe(1:12) ! Note: gravity and pretension cable forces Init%K(IDOF, IDOF) = Init%K( IDOF, IDOF) + Ke(1:12,1:12) Init%M(IDOF, IDOF) = Init%M( IDOF, IDOF) + Me(1:12,1:12) ENDDO @@ -1083,12 +1081,9 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) DO I = 1, Init%nCMass iNode = NINT(Init%CMass(I, 1)) ! Note index where concentrated mass is to be added iGlob = p%NodesDOF(iNode)%List(3) ! uz - Init%FG(iGlob) = Init%FG(iGlob) - Init%CMass(I, 2)*Init%g + p%FG(iGlob) = p%FG(iGlob) - Init%CMass(I, 2)*Init%g ENDDO - ! Copy FG to FG_full since FG will be reduced later - p%FG_full(1:p%nDOF) = Init%FG(1:p%nDOF) - CALL CleanUp_AssembleKM() CONTAINS @@ -1588,7 +1583,6 @@ SUBROUTINE DirectElimination(Init, p, ErrStat, ErrMsg) type(IList), dimension(:), allocatable :: RA !< RA(a) = [e1,..,en] list of elements forming a rigid link assembly integer(IntKi), dimension(:), allocatable :: RAm1 !< RA^-1(e) = a , for a given element give the index of a rigid assembly real(FEKi), dimension(:,:), allocatable :: MM, KK - real(FEKi), dimension(:), allocatable :: FF real(FEKi), dimension(:,:), allocatable :: Temp integer(IntKi) :: nDOF, iDOF, nDOFPerNode, iNode, iiDOF, i,j ErrStat = ErrID_None @@ -1606,11 +1600,9 @@ SUBROUTINE DirectElimination(Init, p, ErrStat, ErrMsg) ! Temporary backup of M and K of full system call move_alloc(Init%M, MM) call move_alloc(Init%K, KK) - call move_alloc(Init%FG, FF) ! Reallocating CALL AllocAry( Init%K, nDOF, nDOF, 'Init%K' , ErrStat2, ErrMsg2); if(Failed()) return; ! system stiffness matrix CALL AllocAry( Init%M, nDOF, nDOF, 'Init%M' , ErrStat2, ErrMsg2); if(Failed()) return; ! system mass matrix - CALL AllocAry( Init%FG, nDOF, 'Init%FG' , ErrStat2, ErrMsg2); if(Failed()) return; ! system gravity force vector CALL AllocAry( Temp ,size(MM,1), nDOF, 'Temp' , ErrStat2, ErrMsg2); if(Failed()) return; CALL AllocAry( p%T_red_T,nDOF , size(MM,1), 'T_red_T' , ErrStat2, ErrMsg2); if(Failed()) return; ! --- Elimination (stack expensive) @@ -1631,7 +1623,6 @@ SUBROUTINE DirectElimination(Init, p, ErrStat, ErrMsg) !Init%K = matmul(p%T_red_T, Temp) CALL LAPACK_gemm( 'T', 'N', 1.0_FeKi, p%T_red, Temp , 0.0_FeKi, Init%K, ErrStat2, ErrMsg2); if(Failed()) return if (allocated(Temp)) deallocate(Temp) - Init%FG = matmul(p%T_red_T, FF) endif !CALL AllocAry( Init%D, nDOF, nDOF, 'Init%D' , ErrStat2, ErrMsg2); if(Failed()) return; ! system damping matrix !Init%D = 0 !< Used for additional damping @@ -1661,7 +1652,6 @@ SUBROUTINE CleanUp_DirectElimination() ! Cleaning up memory if (allocated(MM )) deallocate(MM ) if (allocated(KK )) deallocate(KK ) - if (allocated(FF )) deallocate(FF ) if (allocated(RA )) deallocate(RA ) if (allocated(RAm1)) deallocate(RAm1) if (allocated(Temp)) deallocate(Temp) @@ -2033,39 +2023,34 @@ SUBROUTINE InsertJointStiffDamp(p, Init, ErrStat, ErrMsg) END SUBROUTINE InsertJointStiffDamp !> Returns true if the substructure can be considered "fixed bottom" -!! This is relevant for the ExtraMoment calculation where different reference positions -!! are used depending if translation is fixed of free. -!! As defined in the documentation: -!! The structure is considered “fixed” at the sea bed if at least one reaction node has: -!! - the 4 degrees of freedom accounting for the x-y translation and rotation are fixed -!! OR -!! - an additional stiffness matrix via an SSI input file -LOGICAL FUNCTION isFixedBottom(Init, p) result(bFixed) +LOGICAL FUNCTION isFixedBottom(Init, p) TYPE(SD_InitType), INTENT(IN ) :: Init TYPE(SD_ParameterType),INTENT(IN ) :: p - INTEGER(IntKi) :: i, nFixed - nFixed=0 - do i =1,size(p%Nodes_C,1) - if (ALL(p%Nodes_C(I,2:7)==idBC_Fixed)) then - nFixed=nFixed+1 - elseif (Init%SSIfile(I)/='') then - nFixed=nFixed+1 - endif - enddo - bFixed = nFixed >=1 + isFixedBottom=.not.isFloating(Init,p) + !INTEGER(IntKi) :: i, nFixed + !nFixed=0 + !do i =1,size(p%Nodes_C,1) + ! if (ALL(p%Nodes_C(I,2:7)==idBC_Fixed)) then + ! nFixed=nFixed+1 + ! elseif (Init%SSIfile(I)/='') then + ! nFixed=nFixed+1 + ! endif + !enddo + !bFixed = nFixed >=1 END FUNCTION isFixedBottom !> True if a structure is floating, no fixed BC at the bottom -logical function isFloating(Init, p) result(bFLoating) +logical function isFloating(Init, p) type(SD_InitType), intent(in ):: Init type(SD_ParameterType),intent(in ) :: p integer(IntKi) :: i - bFloating=.True. + !isFloating=size(p%Nodes_C)>0 + isFloating=.True. do i =1,size(p%Nodes_C,1) if ((all(p%Nodes_C(I,2:7)==idBC_Internal)) .and. (Init%SSIfile(i)=='')) then continue else - bFloating=.False. + isFloating=.False. return endif enddo diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index fd10553c91..ccb4344727 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -33,10 +33,6 @@ Module SubDyn PRIVATE - !............................ - ! NOTE: for debugging, add preprocessor definition SD_SUMMARY_DEBUG - ! this will add additional matrices to the SubDyn summary file. - !............................ TYPE(ProgDesc), PARAMETER :: SD_ProgDesc = ProgDesc( 'SubDyn', '', '' ) ! ..... Public Subroutines ................................................................................................... @@ -219,17 +215,9 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! Parse the SubDyn inputs CALL SD_Input(InitInput%SDInputFile, Init, p, ErrStat2, ErrMsg2); if(Failed()) return if (p%Floating) then - if (GUYAN_RIGID_FLOATING) then - call WrScr(' Floating case detected, Guyan modes will be rigid body modes') - else - call WrScr(' Floating case detected') - endif + call WrScr(' Floating case detected, Guyan modes will be rigid body modes') else - if (p%FixedBottom) then - call WrScr(' Fixed bottom case detected') - else - call WrScr(' Mixed free/fixed condary conditions (free/floating assumed)') - endif + call WrScr(' Fixed bottom case detected') endif ! -------------------------------------------------------------------------------- @@ -281,10 +269,10 @@ SUBROUTINE SD_Init( InitInput, u, p, x, xd, z, OtherState, y, m, Interval, InitO ! DOFs into (B,F,L): B=Leader (i.e. Rbar) ,F=Fixed, L=Interior call PartitionDOFNodes(Init, m, p, ErrStat2, ErrMsg2) ; if(Failed()) return if (p%ExtraMoment) then - if (p%FixedBottom) then - call WrScr(' Extra moment will be included in loads (fixed-bottom case detected)') + if (p%Floating) then + call WrScr(' Extra moment and rotated CB-frame will be used (floating case detected)') else - call WrScr(' Extra moment will be included in loads (free/floating case detected)') + call WrScr(' Extra moment will be included in loads (fixed-bottom case detected)') endif endif @@ -420,14 +408,19 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None !locals INTEGER(IntKi) :: I ! Counters - INTEGER(IntKi) :: iSDNode, iY2Node + INTEGER(IntKi) :: iSDNode REAL(ReKi) :: AllOuts(0:MaxOutPts+p%OutAllInt*p%OutAllDims) REAL(ReKi) :: rotations(3) REAL(ReKi) :: ULS(p%nDOF__L), UL0m(p%nDOF__L), FLt(p%nDOF__L) ! Temporary values in static improvement method REAL(ReKi) :: Y1(6) + REAL(ReKi) :: Y1_CB(6) + REAL(ReKi) :: Y1_CB_L(6) + REAL(ReKi) :: Y1_Guy_R(6) + REAL(ReKi) :: Y1_Guy_L(6) + REAL(ReKi) :: Y1_Utp(6) REAL(ReKi) :: Y1_ExtraMoment(3) ! Lever arm moment contributions due to interface displacement + REAL(ReKi) :: udotdot_TP(6) INTEGER(IntKi), pointer :: DOFList(:) - INTEGER(IntKi) :: startDOF REAL(ReKi) :: DCM(3,3) REAL(ReKi) :: F_I(6*p%nNodes_I) ! !Forces from all interface nodes listed in one big array ( those translated to TP ref point HydroTP(6) are implicitly calculated in the equations) TYPE(SD_ContinuousStateType) :: dxdt ! Continuous state derivatives at t- for output file qmdotdot purposes only @@ -439,66 +432,63 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation real(ReKi), dimension(3) :: vP ! Rigid-body velocity of node real(ReKi), dimension(3) :: aP ! Rigid-body acceleration of node - real(R8Ki), dimension(3,3) :: Rot ! Rotation matrix (DCM^t) and delta Rot (DCM^t-I) + real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body coordinates + real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global coordinates + real(R8Ki), dimension(6,6) :: RRb2g ! Rotation matrix global 2 body coordinates, acts on a 6-vector INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - - ! --- Reference coordinate system and body motion + + ! --- Convert inputs to FEM DOFs and convenient 6-vector storage ! Compute the small rotation angles given the input direction cosine matrix rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat2, Errmsg2); if(Failed()) return - Rot(1:3,1:3) = transpose(u%TPMesh%Orientation(:,:,1)) - Om(1:3) = u%TPMesh%RotationVel(1:3,1) - OmD(1:3) = u%TPMesh%RotationAcc(1:3,1) - - ! Inputs at the transition piece: m%u_TP = (/REAL(u%TPMesh%TranslationDisp(:,1),ReKi), rotations/) m%udot_TP = (/u%TPMesh%TranslationVel( :,1), u%TPMesh%RotationVel(:,1)/) m%udotdot_TP = (/u%TPMesh%TranslationAcc( :,1), u%TPMesh%RotationAcc(:,1)/) - - ! External force on internal and interface nodes - call GetExtForceOnInternalDOF( u, p, m, m%UFL, ErrStat2, ErrMsg2 ); if(Failed()) return - call GetExtForceOnInterfaceDOF(p, m%Fext, F_I) - + Rg2b(1:3,1:3) = u%TPMesh%Orientation(:,:,1) ! global 2 body coordinates + Rb2g(1:3,1:3) = transpose(u%TPMesh%Orientation(:,:,1)) + RRb2g(:,:) = 0.0_ReKi + RRb2g(1:3,1:3) = Rb2g + RRb2g(4:6,4:6) = Rb2g + ! -------------------------------------------------------------------------------- - ! --- Output Y2Mesh: motions on all FEM nodes (R, and L DOFs, then full DOF vector) + ! --- Output 2, Y2Mesh: motions on all FEM nodes (R, and L DOFs, then full DOF vector) ! -------------------------------------------------------------------------------- + ! External force on internal nodes (F_L) + call GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, ExtraMoment=(p%ExtraMoment.and..not.p%Floating), RotateLoads=(p%ExtraMoment.and.p%Floating)); if(Failed()) return m%UR_bar = 0.0_ReKi m%UR_bar_dot = 0.0_ReKi m%UR_bar_dotdot = 0.0_ReKi m%UL = 0.0_ReKi m%UL_dot = 0.0_ReKi m%UL_dotdot = 0.0_ReKi - ! --- CB modes contribution to motion (L-DOF only) - IF ( p%nDOFM > 0) THEN + if ( p%nDOFM > 0) then + if (p%Floating) then ! >>> Rotate All + udotdot_TP(1:3) = matmul(Rg2b, u%TPMesh%TranslationAcc( :,1)) + udotdot_TP(4:6) = matmul(Rg2b, u%TPMesh%RotationAcc(:,1) ) + else + udotdot_TP = (/u%TPMesh%TranslationAcc( :,1), u%TPMesh%RotationAcc(:,1)/) + endif m%UL = matmul( p%PhiM, x%qm ) m%UL_dot = matmul( p%PhiM, x%qmdot ) - m%UL_dotdot = matmul( p%C2_61, x%qm ) + matmul( p%C2_62 , x%qmdot ) & - + matmul( p%D2_63, m%udotdot_TP ) + matmul( p%D2_64, m%UFL ) & - + p%F2_61 - END IF + m%UL_dotdot = matmul( p%C2_61, x%qm ) + matmul( p%C2_62 , x%qmdot ) & + + matmul( p%D2_63, udotdot_TP ) + matmul( p%D2_64, m%F_L ) + end if ! Static improvement (modify UL) if (p%SttcSolve/=idSIM_None) then - if (p%SttcSolve==idSIM_Full) then - FLt = MATMUL(p%PhiL_T , m%UFL + p%FGL) - ULS = MATMUL(p%PhiLInvOmgL2, FLt ) ! TODO consider using use a precomputed UL_st_g and KLLm1: ULS = p%UL_st_g + MATMUL(p%KLLm1, m%UFL) - elseif (p%SttcSolve==idSIM_GravOnly) then - FLt = MATMUL(p%PhiL_T , p%FGL) - ULS = MATMUL(p%PhiLInvOmgL2, FLt ) ! TODO consider using use a precomputed UL_st_g and KLLm1: ULS = p%UL_st_g - else - STOP ! Should never happen - endif - m%UL = m%UL + ULS + FLt = MATMUL(p%PhiL_T , m%F_L) ! NOTE: Gravity in F_L + ULS = MATMUL(p%PhiLInvOmgL2, FLt ) if ( p%nDOFM > 0) then UL0M = MATMUL(p%PhiLInvOmgL2(:,1:p%nDOFM), FLt(1:p%nDOFM) ) - m%UL = m%UL - UL0M + ULS = ULS-UL0M end if + m%UL = m%UL + ULS endif ! --- Adding Guyan contribution to R and L DOFs - if ((.not. p%Floating) .or. (.not. GUYAN_RIGID_FLOATING)) then + if (.not.p%Floating) then ! Then we add the Guyan motion here m%UR_bar = matmul( p%TI , m%u_TP ) m%UR_bar_dot = matmul( p%TI , m%udot_TP ) @@ -538,73 +528,132 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) m%U_full_elast = m%U_full ! --- Place displacement/velocity/acceleration into Y2 output mesh - DO iSDNode = 1,p%nNodes - iY2Node = iSDNode - DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations - ! - if (p%Floating .and. GUYAN_RIGID_FLOATING) then - ! For floating case, we add the Guyan motion contribution - ! This accounts for "rotations" effects, where the bottom node should "go up", and not just translate horizontally - ! It corresponds to a rigid body motion the the TP as origin - ! Rigid body motion of the point + if (p%Floating) then + ! For floating, we compute the Guyan motion directly (rigid body motion with TP as origin) + ! This introduce non-linear "rotations" effects, where the bottom node should "go up", and not just translate horizontally + Om(1:3) = u%TPMesh%RotationVel(1:3,1) + OmD(1:3) = u%TPMesh%RotationAcc(1:3,1) + do iSDNode = 1,p%nNodes + DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + ! --- Guyan (rigid body) motion in global coordinates rIP0(1:3) = p%DP0(1:3, iSDNode) - rIP(1:3) = matmul(Rot, rIP0) + rIP(1:3) = matmul(Rb2g, rIP0) duP(1:3) = rIP - rIP0 + m%u_TP(1:3) Om_X_r(1:3) = cross_product(Om, rIP) vP(1:3) = u%TPMesh%TranslationVel(1:3,1) + Om_X_r aP(1:3) = u%TPMesh%TranslationAcc(1:3,1) + cross_product(OmD, rIP) + cross_product(Om, Om_X_r) - m%U_full (DOFList(1:3))= m%U_full (DOFList(1:3)) + duP(1:3) - m%U_full (DOFList(4:6))= m%U_full (DOFList(4:6)) + rotations(1:3) - m%U_full_dot (DOFList(1:3))= m%U_full_dot (DOFList(1:3)) + vP(1:3) - m%U_full_dot (DOFList(4:6))= m%U_full_dot (DOFList(4:6)) + Om(1:3) - m%U_full_dotdot(DOFList(1:3))= m%U_full_dotdot(DOFList(1:3)) + aP(1:3) - m%U_full_dotdot(DOFList(4:6))= m%U_full_dotdot(DOFList(4:6)) + OmD(1:3) + + ! Full displacements CB-rotated + Guyan (KEEP ME) >>> Rotate All + m%U_full (DOFList(1:3)) = matmul(Rb2g, m%U_full (DOFList(1:3))) + duP(1:3) + m%U_full (DOFList(4:6)) = matmul(Rb2g, m%U_full (DOFList(4:6))) + rotations(1:3) + m%U_full_dot (DOFList(1:3)) = matmul(Rb2g, m%U_full_dot (DOFList(1:3))) + vP(1:3) + m%U_full_dot (DOFList(4:6)) = matmul(Rb2g, m%U_full_dot (DOFList(4:6))) + Om(1:3) + m%U_full_dotdot(DOFList(1:3)) = matmul(Rb2g, m%U_full_dotdot(DOFList(1:3))) + aP(1:3) + m%U_full_dotdot(DOFList(4:6)) = matmul(Rb2g, m%U_full_dotdot(DOFList(4:6))) + OmD(1:3) + !m%U_full (DOFList(1:3)) = m%U_full (DOFList(1:3)) + duP(1:3) + !m%U_full (DOFList(4:6)) = m%U_full (DOFList(4:6)) + rotations(1:3) + !m%U_full_dot (DOFList(1:3)) = m%U_full_dot (DOFList(1:3)) + vP(1:3) + !m%U_full_dot (DOFList(4:6)) = m%U_full_dot (DOFList(4:6)) + Om(1:3) + !m%U_full_dotdot(DOFList(1:3)) = m%U_full_dotdot(DOFList(1:3)) + aP(1:3) + !m%U_full_dotdot(DOFList(4:6)) = m%U_full_dotdot(DOFList(4:6)) + OmD(1:3) + + ! NOTE: For now, displacements passed to HydroDyn are Guyan only! + ! Construct the direction cosine matrix given the output angles + !call SmllRotTrans( 'UR_bar input angles', m%U_full(DOFList(4)), m%U_full(DOFList(5)), m%U_full(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) + call SmllRotTrans( 'UR_bar input angles', rotations(1), rotations(2), rotations(3), DCM, '', ErrStat2, ErrMsg2) ! NOTE: using only Guyan rotations + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') + y%Y2mesh%Orientation (:,:,iSDNode) = DCM + !y%Y2mesh%TranslationDisp (:,iSDNode) = m%U_full (DOFList(1:3)) + y%Y2mesh%TranslationDisp (:,iSDNode) = duP(1:3) ! NOTE: using only the Guyan Displacements + y%Y2mesh%TranslationVel (:,iSDNode) = m%U_full_dot (DOFList(1:3)) + y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) + y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) + y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) + enddo + else + ! --- Fixed bottom + do iSDNode = 1,p%nNodes + DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + ! TODO TODO which orientation to give for joints with more than 6 dofs? + ! Construct the direction cosine matrix given the output angles + CALL SmllRotTrans( 'UR_bar input angles', m%U_full(DOFList(4)), m%U_full(DOFList(5)), m%U_full(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') + y%Y2mesh%Orientation (:,:,iSDNode) = DCM + y%Y2mesh%TranslationDisp (:,iSDNode) = m%U_full (DOFList(1:3)) + y%Y2mesh%TranslationVel (:,iSDNode) = m%U_full_dot (DOFList(1:3)) + y%Y2mesh%TranslationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(1:3)) + y%Y2mesh%RotationVel (:,iSDNode) = m%U_full_dot (DOFList(4:6)) + y%Y2mesh%RotationAcc (:,iSDNode) = m%U_full_dotdot (DOFList(4:6)) + enddo + endif + + ! -------------------------------------------------------------------------------- + ! --- Outputs 1, Y1=-F_TP, reaction force from SubDyn to ElastoDyn (stored in y%Y1Mesh) + ! -------------------------------------------------------------------------------- + ! --- Special case for floating with extramoment + if (p%ExtraMoment.and.p%Floating) then + Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! Uses rotated loads + endif + + ! Compute external force on internal (F_L) and interface nodes (F_I) + call GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, ExtraMoment=(p%ExtraMoment), RotateLoads=.False.); if(Failed()) return + call GetExtForceOnInterfaceDOF(p, m%Fext, F_I) + + ! Compute reaction/coupling force at TP + Y1_Utp = - (matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(p%MBB, m%udotdot_TP) ) + if (p%nDOFM>0) then + !>>> Rotate All + ! NOTE: this introduces some hysteresis + !if (p%Floating) then + ! udotdot_TP(1:3) = matmul(Rg2b, u%TPMesh%TranslationAcc( :,1)) + ! udotdot_TP(4:6) = matmul(Rg2b, u%TPMesh%RotationAcc(:,1) ) + ! Y1_Utp = Y1_Utp + matmul(RRb2g, matmul(p%MBmmB, udotdot_TP)) + !else + Y1_Utp = Y1_Utp + matmul(p%MBmmB, m%udotdot_TP) + !endif + endif + if ( p%nDOFM > 0) then + Y1_CB = -( matmul(p%C1_11, x%qm) + matmul(p%C1_12, x%qmdot) ) + if (p%Floating) then + Y1_CB = matmul(RRb2g, Y1_CB) !>>> Rotate All endif - ! TODO TODO which orientation to give for joints with more than 6 dofs? - ! Construct the direction cosine matrix given the output angles - CALL SmllRotTrans( 'UR_bar input angles', m%U_full(DOFList(4)), m%U_full(DOFList(5)), m%U_full(DOFList(6)), DCM, '', ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcOutput') - y%Y2mesh%Orientation (:,:,iY2Node) = DCM - y%Y2mesh%TranslationDisp (:,iY2Node) = m%U_full (DOFList(1:3)) - y%Y2mesh%TranslationVel (:,iY2Node) = m%U_full_dot (DOFList(1:3)) - y%Y2mesh%TranslationAcc (:,iY2Node) = m%U_full_dotdot (DOFList(1:3)) - y%Y2mesh%RotationVel (:,iY2Node) = m%U_full_dot (DOFList(4:6)) - y%Y2mesh%RotationAcc (:,iY2Node) = m%U_full_dotdot (DOFList(4:6)) - enddo - !________________________________________ - ! Set loads outputs on y%Y1Mesh - !________________________________________ - ! --------------------------------------------------------------------------------- - !Y1= TP reaction Forces, i.e. force that the jacket exerts onto the TP and above - ! --------------------------------------------------------------------------------- - ! Eq. 15: Y1 = -(C1*x + D1*u + FY) [note the negative sign!!!!] - !HydroTP = matmul(transpose(p%TI), F_I) ! (6,1) calculated below - ! note: matmul( F_I, p%TI ) = matmul( transpose(p%TI), F_I) because F_I is 1-D - IF ( p%nDOFM > 0) THEN - Y1 = -( matmul(p%C1_11, x%qm) + matmul(p%C1_12,x%qmdot) & ! -( C1(1,1)*x(1) + C1(1,2)*x(2) - + matmul(p%KBB, m%u_TP) + matmul(p%D1_12, m%udot_TP) + matmul(p%D1_13, m%udotdot_TP) + matmul(p%D1_14, m%UFL) & ! + D1(1,1)*u(1) + 0*u(2) + D1(1,3)*u(3) + D1(1,4)*u(4) - - matmul( F_I, p%TI ) + p%FY ) ! + D1(1,5)*u(5) + Fy(1) ) - ELSE ! No retained modes, so there are no states - Y1 = -( matmul(p%KBB, m%u_TP) + matmul(p%D1_12, m%udot_TP) + matmul(p%D1_13, m%udotdot_TP) + matmul(p%D1_14, m%UFL) & ! -( 0*x + D1(1,1)*u(1) + 0*u(2) + D1(1,3)*u(3) + D1(1,4)*u(4) - - matmul( F_I, p%TI ) + p%FY ) ! + D1(1,5)*u(5) + Fy(1) ) - END IF + else + Y1_CB = 0.0_ReKi + endif + Y1_Guy_R = matmul( F_I, p%TI ) + Y1_Guy_L = - matmul(p%D1_142, m%F_L) ! non rotated loads + if (.not.(p%ExtraMoment.and.p%Floating)) then + Y1_CB_L = - (matmul(p%D1_141, m%F_L)) ! Uses non rotated loads + endif + if (p%Floating) then + Y1_CB_L = matmul(RRb2g, Y1_CB_L) !>>> Rotate All + endif + + Y1 = Y1_CB + Y1_Utp + Y1_CB_L+ Y1_Guy_L + Y1_Guy_R + ! KEEP ME + !if ( p%nDOFM > 0) then + ! Y1 = -( matmul(p%C1_11, x%qm) + matmul(p%C1_12,x%qmdot) & + ! + matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(p%MBB - p%MBmmB, m%udotdot_TP) & + ! + matmul(p%D1_141, m%F_L) + matmul(p%D1_142, m%F_L) - matmul( F_I, p%TI ) ) + !else ! No retained modes, so there are no states + ! Y1 = -( matmul(p%KBB, m%u_TP) + matmul(p%CBB, m%udot_TP) + matmul(p%MBB - p%MBmmB, m%udotdot_TP) & + ! + matmul(p%D1_141, m%F_L) + matmul(p%D1_142, m%F_L) - matmul( F_I, p%TI ) ) + !end if + ! Computing extra moments due to lever arm introduced by interface displacement - ! Y1(:3) = -f_TP - ! MExtra = -u_TP x f_TP - ! Y1_MExtra = - MExtra = -u_TP x Y1(1:3) ! NOTE: double cancelling of signs + ! Y1_MExtra = - MExtra = -u_TP x Y1(1:3) ! NOTE: double cancellation of signs if (p%ExtraMoment) then - if (p%FixedBottom) then ! if Fixed, transfer from non deflected TP to u_TP + if (.not.p%floating) then ! if Fixed, transfer from non deflected TP to u_TP Y1_ExtraMoment(1) = - m%u_TP(2) * Y1(3) + m%u_TP(3) * Y1(2) Y1_ExtraMoment(2) = - m%u_TP(3) * Y1(1) + m%u_TP(1) * Y1(3) Y1_ExtraMoment(3) = - m%u_TP(1) * Y1(2) + m%u_TP(2) * Y1(1) Y1(4:6) = Y1(4:6) + Y1_ExtraMoment endif endif - ! values on the interface mesh are Y1 (SubDyn forces) + Hydrodynamic forces y%Y1Mesh%Force (:,1) = Y1(1:3) y%Y1Mesh%Moment(:,1) = Y1(4:6) - + !________________________________________ ! CALCULATE OUTPUT TO BE WRITTEN TO FILE !________________________________________ @@ -617,13 +666,16 @@ SUBROUTINE SD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! call CalcContStateDeriv one more time to store these qmdotdot for debugging purposes in the output file !find xdot at t IF ( p%nDOFM > 0 ) THEN - ! note that this re-sets m%udotdot_TP and m%UFL, but they are the same values as earlier in this routine so it doesn't change results in SDOut_MapOutputs() + ! note that this re-sets m%udotdot_TP and m%F_L, but they are the same values as earlier in this routine so it doesn't change results in SDOut_MapOutputs() CALL SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ); if(Failed()) return !Assign the acceleration to the x variable since it will be used for output file purposes for SSqmdd01-99, and dxdt will disappear m%qmdotdot=dxdt%qmdot ! Destroy dxdt because it is not necessary for the rest of the subroutine CALL SD_DestroyContState( dxdt, ErrStat2, ErrMsg2); if(Failed()) return END IF + ! 6-vectors (making sure they are up to date for outputs + m%udot_TP = (/u%TPMesh%TranslationVel( :,1),u%TPMesh%RotationVel(:,1)/) + m%udotdot_TP = (/u%TPMesh%TranslationAcc(:,1), u%TPMesh%RotationAcc(:,1)/) ! Write the previous output data into the output file IF ( ( p%OutSwtch == 1 .OR. p%OutSwtch == 3 ) .AND. ( t > m%LastOutTime ) ) THEN @@ -663,7 +715,7 @@ END SUBROUTINE SD_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Tight coupling routine for computing derivatives of continuous states -!! note that this also sets m%UFL and m%udotdot_TP +!! note that this also sets m%F_L and m%udotdot_TP SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(SD_InputType), INTENT(IN ) :: u !< Inputs at t @@ -676,6 +728,7 @@ SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta TYPE(SD_ContinuousStateType), INTENT( OUT) :: dxdt !< Continuous state derivatives at t INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(ReKi) :: udotdot_TP(6) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 ! Initialize ErrStat @@ -686,22 +739,22 @@ SUBROUTINE SD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSta CALL AllocAry(dxdt%qm, p%nDOFM, 'dxdt%qm', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) CALL AllocAry(dxdt%qmdot, p%nDOFM, 'dxdt%qmdot', ErrStat2, ErrMsg2 ); CALL SetErrStat ( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_CalcContStateDeriv' ) IF ( ErrStat >= AbortErrLev ) RETURN - IF ( p%nDOFM == 0 ) RETURN + + ! Compute F_L, force on internal DOF + CALL GetExtForceOnInternalDOF(u, p, x, m, m%F_L, ErrStat2, ErrMsg2, ExtraMoment=(p%ExtraMoment.and..not.p%Floating), RotateLoads=(p%ExtraMoment.and.p%Floating)) + + udotdot_TP = (/u%TPMesh%TranslationAcc(:,1), u%TPMesh%RotationAcc(:,1)/) + if (p%Floating) then + ! >>> Rotate All - udotdot_TP to body coordinates + udotdot_TP(1:3) = matmul( u%TPMesh%Orientation(:,:,1), udotdot_TP(1:3) ) + udotdot_TP(4:6) = matmul( u%TPMesh%Orientation(:,:,1), udotdot_TP(4:6) ) + endif - ! form u(3) in Eq. 10: - m%udotdot_TP = (/u%TPMesh%TranslationAcc(:,1), u%TPMesh%RotationAcc(:,1)/) - - ! form u(4) in Eq. 10: - CALL GetExtForceOnInternalDOF( u, p, m, m%UFL, ErrStat2, ErrMsg2 ); - - !Equation 12: X=A*x + B*u + Fx (Eq 12) + ! State equation dxdt%qm= x%qmdot - - ! NOTE: matmul( TRANSPOSE(p%PhiM), m%UFL ) = matmul( m%UFL, p%PhiM ) because UFL is 1-D - != a(2,1) * x(1) + a(2,2) * x(2) + b(2,3) * u(3) + b(2,4) * u(4) + fx(2) - !dxdt%qmdot = -p%KMMDiag*x%qm + p%CMMDiag*x%qmdot - matmul(p%CMB,m%udotdot_TP)- matmul(p%MMB,m%udotdot_TP) + matmul(p%PhiM_T,m%UFL) + p%FX - dxdt%qmdot = -p%KMMDiag*x%qm - p%CMMDiag*x%qmdot - matmul(p%CMB,m%udot_TP) - matmul(p%MMB,m%udotdot_TP) + matmul(m%UFL, p%PhiM) + p%FX + ! NOTE: matmul( TRANSPOSE(p%PhiM), m%F_L ) = matmul( m%F_L, p%PhiM ) because F_L is 1-D + dxdt%qmdot = -p%KMMDiag*x%qm - p%CMMDiag*x%qmdot - matmul(p%MMB,udotdot_TP) + matmul(m%F_L, p%PhiM) END SUBROUTINE SD_CalcContStateDeriv @@ -955,7 +1008,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) Init%SSIK = 0.0_ReKi ! Important init TODO: read these matrices on the fly in SD_FEM maybe? Init%SSIM = 0.0_ReKi ! Important init ! Reading reaction lines one by one, allowing for 1, 7 or 8 columns, with col8 being a string for the SSIfile -DO I = 1, p%nNodes_C +do I = 1, p%nNodes_C READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading reaction line'; if (Failed()) return call ReadIAryFromStr(Line, p%Nodes_C(I,:), 8, nColValid, nColNumeric, Init%SSIfile(I:I)); if (nColValid==1 .and. nColNumeric==1) then @@ -964,10 +1017,10 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) else if (nColNumeric==7 .and.(nColValid==7.or.nColValid==8)) then ! This is fine. else - CALL Fatal(' Error in file "'//TRIM(SDInputFile)//'": Reaction lines must consist of 7 numerical values, followed by an optional string. Problematic line: "'//trim(Line)//'"') + call Fatal(' Error in file "'//TRIM(SDInputFile)//'": Reaction lines must consist of 7 numerical values, followed by an optional string. Problematic line: "'//trim(Line)//'"') return endif -ENDDO +enddo IF (Check ( p%nNodes_C > Init%NJoints , 'NReact must be less than number of joints')) return call CheckBCs(p, ErrStat2, ErrMsg2); if (Failed()) return @@ -979,9 +1032,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) endif enddo ! Trigger: determine if floating/fixed based on BCs and SSI file -p%FixedBottom = isFixedBottom(Init,p) -p%Floating = isFloating(Init,p) - +p%Floating = isFloating(Init,p) !------- INTERFACE JOINTS: T/F for Locked (to the TP)/Free DOF @each Interface Joint (only Locked-to-TP implemented thus far (=rigid TP)) --------- @@ -1674,9 +1725,9 @@ SUBROUTINE SD_AM2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables TYPE(SD_InputType) :: u_interp ! interpolated value of inputs - REAL(ReKi) :: junk2(2*p%nDOFM) !temporary states (qm and qmdot only) + REAL(ReKi) :: xq(2*p%nDOFM) !temporary states (qm and qmdot only) REAL(ReKi) :: udotdot_TP2(6) ! temporary copy of udotdot_TP - REAL(ReKi) :: UFL2(p%nDOF__L) ! temporary copy of UFL + REAL(ReKi) :: F_L2(p%nDOF__L) ! temporary copy of F_L INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1689,34 +1740,42 @@ SUBROUTINE SD_AM2( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg !Start by getting u_n and u_n+1 ! interpolate u to find u_interp = u(t) = u_n CALL SD_Input_ExtrapInterp( u, utimes, u_interp, t, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') + CALL GetExtForceOnInternalDOF(u_interp, p, x, m, m%F_L, ErrStat2, ErrMsg2, ExtraMoment=(p%ExtraMoment.and..not.p%Floating), RotateLoads=(p%ExtraMoment.and.p%Floating)) m%udotdot_TP = (/u_interp%TPMesh%TranslationAcc(:,1), u_interp%TPMesh%RotationAcc(:,1)/) - CALL GetExtForceOnInternalDOF( u_interp, p, m, m%UFL, ErrStat2, ErrMsg2 ); + if (p%Floating) then + ! >>> Rotate All - udotdot_TP to body coordinates + m%udotdot_TP(1:3) = matmul(u_interp%TPMesh%Orientation(:,:,1), m%udotdot_TP(1:3)) + m%udotdot_TP(4:6) = matmul(u_interp%TPMesh%Orientation(:,:,1), m%udotdot_TP(4:6)) + endif ! extrapolate u to find u_interp = u(t + dt)=u_n+1 CALL SD_Input_ExtrapInterp(u, utimes, u_interp, t+p%SDDeltaT, ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') + CALL GetExtForceOnInternalDOF(u_interp, p, x, m, F_L2, ErrStat2, ErrMsg2, ExtraMoment=(p%ExtraMoment.and..not.p%Floating), RotateLoads=(p%ExtraMoment.and.p%Floating)) udotdot_TP2 = (/u_interp%TPMesh%TranslationAcc(:,1), u_interp%TPMesh%RotationAcc(:,1)/) - CALL GetExtForceOnInternalDOF( u_interp, p, m, UFL2, ErrStat2, ErrMsg2 ); + if (p%Floating) then + ! >>> Rotate All - udotdot_TP to body coordinates + udotdot_TP2(1:3) = matmul(u_interp%TPMesh%Orientation(:,:,1), udotdot_TP2(1:3)) + udotdot_TP2(4:6) = matmul(u_interp%TPMesh%Orientation(:,:,1), udotdot_TP2(4:6)) + endif ! calculate (u_n + u_n+1)/2 udotdot_TP2 = 0.5_ReKi * ( udotdot_TP2 + m%udotdot_TP ) - UFL2 = 0.5_ReKi * ( UFL2 + m%UFL ) + F_L2 = 0.5_ReKi * ( F_L2 + m%F_L ) - ! set junk2 = dt * ( A*x_n + B *(u_n + u_n+1)/2 + Fx) - junk2( 1: p%nDOFM)=p%SDDeltaT * x%qmdot !upper portion of array - junk2(1+p%nDOFM:2*p%nDOFM)=p%SDDeltaT * (-p%KMMDiag*x%qm - p%CMMDiag*x%qmdot - matmul(p%MMB, udotdot_TP2) + matmul(UFL2,p%PhiM ) + p%FX) !lower portion of array - ! note: matmul(UFL2,p%PhiM ) = matmul(p%PhiM_T,UFL2) because UFL2 is 1-D + ! set xq = dt * ( A*x_n + B *(u_n + u_n+1)/2 + Fx) + xq( 1: p%nDOFM)=p%SDDeltaT * x%qmdot !upper portion of array + xq(1+p%nDOFM:2*p%nDOFM)=p%SDDeltaT * (-p%KMMDiag*x%qm - p%CMMDiag*x%qmdot - matmul(p%MMB, udotdot_TP2) + matmul(F_L2,p%PhiM )) !lower portion of array + ! note: matmul(F_L2,p%PhiM ) = matmul(p%PhiM_T,F_L2) because F_L2 is 1-D !.................................................... - ! Solve for junk2: (equivalent to junk2= matmul(p%AM2InvJac,junk2) + ! Solve for xq: (equivalent to xq= matmul(p%AM2InvJac,xq) ! J*( x_n - x_n+1 ) = dt * ( A*x_n + B *(u_n + u_n+1)/2 + Fx) !.................................................... - CALL LAPACK_getrs( TRANS='N',N=SIZE(p%AM2Jac,1),A=p%AM2Jac,IPIV=p%AM2JacPiv, B=junk2, ErrStat=ErrStat2, ErrMsg=ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') - !IF ( ErrStat >= AbortErrLev ) RETURN + CALL LAPACK_getrs( TRANS='N',N=SIZE(p%AM2Jac,1),A=p%AM2Jac,IPIV=p%AM2JacPiv, B=xq, ErrStat=ErrStat2, ErrMsg=ErrMsg2); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SD_AM2') - ! after the LAPACK solve, junk2 = ( x_n - x_n+1 ); so now we can solve for x_n+1: - x%qm = x%qm - junk2( 1: p%nDOFM) - x%qmdot = x%qmdot - junk2(p%nDOFM+1:2*p%nDOFM) + ! after the LAPACK solve, xq = ( x_n - x_n+1 ); so now we can solve for x_n+1: + x%qm = x%qm - xq( 1: p%nDOFM) + x%qmdot = x%qmdot - xq(p%nDOFM+1:2*p%nDOFM) ! clean up temporary variable(s) CALL SD_DestroyInput( u_interp, ErrStat, ErrMsg ) @@ -2146,7 +2205,6 @@ SUBROUTINE SD_Craig_Bampton(Init, p, CB, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(FEKi), ALLOCATABLE :: FGR(:), FGL(:), FGB(:), FGM(:) !< Partitioned Force (R/L), and CB reduced forces(B/M) REAL(FEKi), ALLOCATABLE :: PhiRb(:, :) ! Purely to avoid loosing these modes for output ! TODO, kept for backward compatibility of Summary file REAL(ReKi) :: JDamping1 ! temporary storage for first element of JDamping array INTEGER(IntKi) :: nR !< Dimension of R DOFs (to switch between __R and R__) @@ -2195,10 +2253,6 @@ SUBROUTINE SD_Craig_Bampton(Init, p, CB, ErrStat, ErrMsg) nM = p%nDOFM CALL WrScr(' Performing Craig-Bampton reduction '//trim(Num2LStr(p%nDOF_red))//' DOFs -> '//trim(Num2LStr(p%nDOFM))//' modes + '//trim(Num2LStr(p%nDOF__Rb))//' DOFs') - CALL AllocAry( FGL, nL, 'array FGL', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( FGR, nR, 'array FGR', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( FGB, nR, 'array FGR', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry( FGM, nM, 'array FGR', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry( CB%MBB, nR, nR, 'CB%MBB', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry( CB%MBM, nR, nM, 'CB%MBM', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry( CB%KBB, nR, nR, 'CB%KBB', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2206,19 +2260,18 @@ SUBROUTINE SD_Craig_Bampton(Init, p, CB, ErrStat, ErrMsg) CALL AllocAry( CB%PhiR, nL, nR, 'CB%PhiR', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL AllocAry( CB%OmegaL, nM_out, 'CB%OmegaL', ErrStat2, ErrMsg2 ); if(Failed()) return - CALL CraigBamptonReduction(Init%M, Init%K, IDR, nR, p%ID__L, nL, nM, nM_out, CB%MBB, CB%MBM, CB%KBB, CB%PhiL, CB%PhiR, CB%OmegaL, ErrStat2, ErrMsg2,& - Init%FG, FGR, FGL, FGB, FGM) + CALL CraigBamptonReduction(Init%M, Init%K, IDR, nR, p%ID__L, nL, nM, nM_out, CB%MBB, CB%MBM, CB%KBB, CB%PhiL, CB%PhiR, CB%OmegaL, ErrStat2, ErrMsg2) if(Failed()) return CALL AllocAry(PhiRb, nL, nR, 'PhiRb', ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if(.not.BC_Before_CB) then ! We apply the BC now, removing unwanted DOFs - call applyConstr(CB, FGB, PhiRb) ! Reduces size of CB%MBB, CB%KBB, CB%MBM, FGB, NOTE: "L" unaffected + call applyConstr(CB, PhiRb) ! Reduces size of CB%MBB, CB%KBB, CB%MBM, NOTE: "L" unaffected else PhiRb=CB%PhiR ! Remove me in the future endif ! TODO, right now using PhiRb instead of CB%PhiR, keeping PhiR in harmony with OmegaL for SummaryFile - CALL SetParameters(Init, p, CB%MBB, CB%MBM, CB%KBB, PhiRb, nM_out, CB%OmegaL, CB%PhiL, FGL, FGB, FGM, ErrStat2, ErrMsg2) + CALL SetParameters(Init, p, CB%MBB, CB%MBM, CB%KBB, PhiRb, nM_out, CB%OmegaL, CB%PhiL, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'Craig_Bampton') CALL CleanUpCB() @@ -2238,33 +2291,26 @@ logical function Failed() end function Failed subroutine CleanUpCB() - IF(ALLOCATED(FGR) ) DEALLOCATE(FGR) - IF(ALLOCATED(FGL) ) DEALLOCATE(FGL) - IF(ALLOCATED(FGM) ) DEALLOCATE(FGM) - IF(ALLOCATED(FGB) ) DEALLOCATE(FGB) IF(ALLOCATED(PhiRb)) DEALLOCATE(PhiRb) end subroutine CleanUpCB !> Remove fixed DOF from system, this is in case the CB was done on an unconstrained system !! NOTE: PhiL and OmegaL are not modified - subroutine applyConstr(CBParams, FGB, PhiRb) + subroutine applyConstr(CBParams, PhiRb) TYPE(CB_MatArrays), INTENT(INOUT) :: CBparams !< NOTE: data will be reduced (andw hence reallocated) - REAL(FEKi),ALLOCATABLE,INTENT(INOUT) :: FGB(:) !< NOTE: data will be reduced (andw hence reallocated) REAL(FEKi),ALLOCATABLE,INTENT(INOUT) :: PhiRb(:,:)!< NOTE: data will be reduced (andw hence reallocated) !REAL(ReKi), ALLOCATABLE :: PhiRb(:, :) REAL(FEKi), ALLOCATABLE :: MBBb(:, :) REAL(FEKi), ALLOCATABLE :: MBMb(:, :) REAL(FEKi), ALLOCATABLE :: KBBb(:, :) - REAL(FEKi), ALLOCATABLE :: FGBb(:) ! "b" stands for "bar" CALL AllocAry( MBBb, p%nDOF__Rb, p%nDOF__Rb, 'matrix MBBb', ErrStat2, ErrMsg2 ); CALL AllocAry( MBmb, p%nDOF__Rb, p%nDOFM, 'matrix MBmb', ErrStat2, ErrMsg2 ); CALL AllocAry( KBBb, p%nDOF__Rb, p%nDOF__Rb, 'matrix KBBb', ErrStat2, ErrMsg2 ); - CALL AllocAry( FGBb, p%nDOF__Rb, 'array FGBb', ErrStat2, ErrMsg2 ); !CALL AllocAry( PhiRb, p%nDOF__L , p%nDOF__Rb, 'matrix PhiRb', ErrStat2, ErrMsg2 ); !................................ - ! Convert CBparams%MBB , CBparams%MBM , CBparams%KBB , CBparams%PhiR , FGB to - ! MBBb, MBMb, KBBb, PHiRb, FGBb + ! Convert CBparams%MBB , CBparams%MBM , CBparams%KBB , CBparams%PhiR , to + ! MBBb, MBMb, KBBb, PHiRb, ! (throw out rows/columns of first matrices to create second matrices) !................................ ! TODO avoid this all together @@ -2273,7 +2319,6 @@ subroutine applyConstr(CBParams, FGB, PhiRb) IF (p%nDOFM > 0) THEN MBMb = CBparams%MBM(p%nDOFR__-p%nDOFI__+1:p%nDOFR__, : ) END IF - FGBb = FGB (p%nDOFR__-p%nDOFI__+1:p%nDOFR__ ) PhiRb = CBparams%PhiR( :, p%nDOFR__-p%nDOFI__+1:p%nDOFR__) deallocate(CBparams%MBB) deallocate(CBparams%KBB) @@ -2282,7 +2327,6 @@ subroutine applyConstr(CBParams, FGB, PhiRb) call move_alloc(MBBb, CBparams%MBB) call move_alloc(KBBb, CBparams%KBB) call move_alloc(MBMb, CBparams%MBM) - call move_alloc(FGBb, FGB) !call move_alloc(PhiRb, CBparams%PhiR) end subroutine applyConstr @@ -2343,7 +2387,7 @@ END SUBROUTINE SD_Guyan_RigidBodyMass !------------------------------------------------------------------------------------------------------ !> Set parameters to compute state and output equations !! NOTE: this function converst from FEKi to ReKi -SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, FGL, FGB, FGM, ErrStat, ErrMsg) +SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, ErrStat, ErrMsg) use NWTC_LAPACK, only: LAPACK_GEMM, LAPACK_getrf TYPE(SD_InitType), INTENT(IN ) :: Init ! Input data for initialization routine TYPE(SD_ParameterType), INTENT(INOUT) :: p ! Parameters @@ -2354,9 +2398,6 @@ SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, REAL(FEKi), INTENT(IN ) :: PhiL ( p%nDOF__L, nM_out) REAL(FEKi), INTENT(IN ) :: PhiRb( p%nDOF__L, p%nDOF__Rb) REAL(FEKi), INTENT(IN ) :: OmegaL(nM_out) - REAL(FEKi), INTENT(IN ) :: FGB(p%nDOF__Rb) - REAL(FEKi), INTENT(IN ) :: FGL(p%nDOF__L) - REAL(FEKi), INTENT(IN ) :: FGM(p%nDOFM) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables @@ -2394,8 +2435,6 @@ SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, CALL AllocAry( p%PhiL_T, p%nDOF__L, p%nDOF__L, 'p%PhiL_T', ErrStat2, ErrMsg2 ); if(Failed())return CALL AllocAry( p%PhiLInvOmgL2, p%nDOF__L, p%nDOF__L, 'p%PhiLInvOmgL2', ErrStat2, ErrMsg2 ); if(Failed())return CALL AllocAry( p%KLLm1 , p%nDOF__L, p%nDOF__L, 'p%KLLm1', ErrStat2, ErrMsg2 ); if(Failed())return - CALL AllocAry( p%FGL, p%nDOF__L, 'p%FGL', ErrStat2, ErrMsg2 ); if(Failed())return - CALL AllocAry( p%UL_st_g, p%nDOF__L, 'p%UL_st_g', ErrStat2, ErrMsg2 ); if(Failed())return ! TODO PhiL_T and PhiLInvOmgL2 may not be needed if KLLm1 is stored. p%PhiL_T=TRANSPOSE(PhiL) !transpose of PhiL for static improvement do I = 1, nM_out @@ -2404,8 +2443,6 @@ SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, ! KLL^-1 = [PhiL] x [OmegaL^2]^-1 x [PhiL]^t !p%KLLm1 = MATMUL(p%PhiLInvOmgL2, p%PhiL_T) ! Inverse of KLL: KLL^-1 = [PhiL] x [OmegaL^2]^-1 x [PhiL]^t CALL LAPACK_gemm( 'N', 'N', 1.0_ReKi, p%PhiLInvOmgL2, p%PhiL_T, 0.0_ReKi, p%KLLm1, ErrStat2, ErrMsg2); if(Failed()) return - p%FGL = FGL - p%UL_st_g = MATMUL(p%KLLm1, FGL) endif ! block element of D2 matrix (D2_21, D2_42, & part of D2_62) @@ -2438,12 +2475,8 @@ SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, ! TODO cant use LAPACK due to type conversions FEKi->ReKi p%MBM = MATMUL( TI_transpose, MBmb ) ! NOTE: type conversion !CALL LAPACK_gemm( 'T', 'N', 1.0_ReKi, p%TI, MBmb, 0.0_ReKi, p%MBM, ErrStat2, ErrMsg2); if(Failed()) return - !p%CBM = MATMUL( TRANSPOSE(p%TI), CBMb ) != CBMt - !CALL LAPACK_gemm( 'T', 'N', 1.0_ReKi, p%TI, CBMb, 0.0_ReKi, p%CBM, ErrStat2, ErrMsg2); if (Failed()) return - p%CBM = 0.0_ReKi ! TODO no cross couplings p%MMB = TRANSPOSE( p%MBM ) != MMBt - p%CMB = TRANSPOSE( p%CBM ) != CMBt p%PhiM = real( PhiL(:,1:p%nDOFM), ReKi) @@ -2451,35 +2484,22 @@ SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, p%KMMDiag= OmegaL(1:p%nDOFM) * OmegaL(1:p%nDOFM) ! OmegaM is a one-dimensional array p%CMMDiag = 2.0_ReKi * OmegaL(1:p%nDOFM) * Init%JDampings(1:p%nDOFM) ! Init%JDampings is also a one-dimensional array - ! FX = matmul( transpose(PhiM), FGL ) (output of CraigBamptonReduction) - p%FX = FGM - ! C1_11, C1_12 ( see eq 15 [multiply columns by diagonal matrix entries for diagonal multiply on the left]) DO I = 1, p%nDOFM ! if (p%nDOFM=p%nDOFM=nDOFM == 0), this loop is skipped - p%C1_11(:, I) = -p%MBM(:, I)*p%KMMDiag(I) - p%C1_12(:, I) = p%CBM(:,I) -p%MBM(:, I)*p%CMMDiag(I) + p%C1_11(:, I) = -p%MBM(:, I)*p%KMMDiag(I) + p%C1_12(:, I) = -p%MBM(:, I)*p%CMMDiag(I) ENDDO ! D1 Matrices - ! D1_12 = CBBt - MBmt*CmBt - !CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%MBM, p%CBM, 0.0_ReKi, p%D1_13, ErrStat2, ErrMsg2 ); if(Failed()) return ! p%D1_12 = MATMUL( p%MBM, p%CMB ) - p%D1_12 = MATMUL( p%MBM, p%CMB ) - p%D1_12 = p%CBB - p%D1_12 - ! D1_13 = MBBt - MBmt*MmBt - !p%D1_13 = p%MBB - MATMUL( p%MBM, p%MMB ) - CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%MBM, p%MBM, 0.0_ReKi, p%D1_13, ErrStat2, ErrMsg2 ); if(Failed()) return ! p%D1_13 = MATMUL( p%MBM, p%MMB ) - p%D1_13 = p%MBB - p%D1_13 + ! MBmt*MmBt + CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%MBM, p%MBM, 0.0_ReKi, p%MBmmB, ErrStat2, ErrMsg2 ); if(Failed()) return ! MATMUL( p%MBM, p%MMB ) - ! TODO cant use LAPACK due to type conversions FEKi->ReKi - !p%D1_14 = MATMUL( p%MBM, p%PhiM_T ) - MATMUL( TI_transpose, TRANSPOSE(PhiRb)) - p%D1_14 = MATMUL( TI_transpose, TRANSPOSE(PhiRb)) - !CALL LAPACK_GEMM( 'T', 'T', 1.0_ReKi, p%TI, PhiRb, 0.0_ReKi, p%D1_14, ErrStat2, ErrMsg2 ); if(Failed()) return ! p%D1_14 = MATMUL( TRANSPOSE(TI), TRANSPOSE(PHiRb)) - CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%MBM, p%PhiM, -1.0_ReKi, p%D1_14, ErrStat2, ErrMsg2 ); if(Failed()) return ! p%D1_14 = MATMUL( p%MBM, TRANSPOSE(p%PhiM) ) - p%D1_14 + ! --- Intermediates D1_14 = D1_141 + D1_142 + !p%D1_141 = MATMUL(p%MBM, TRANSPOSE(p%PhiM)) + CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%MBM, p%PhiM, 0.0_ReKi, p%D1_141, ErrStat2, ErrMsg2 ); if(Failed()) return + ! NOTE: cant use LAPACK due to type conversions FEKi->ReKi + p%D1_142 =- MATMUL(TI_transpose, TRANSPOSE(PhiRb)) - - ! FY (with retained modes) - p%FY = MATMUL( p%MBM, p%FX ) & - - MATMUL( TI_transpose, FGB ) ! C2_21, C2_42 ! C2_61, C2_62 @@ -2495,9 +2515,6 @@ SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, !p%D2_64 = MATMUL( p%PhiM, p%PhiM_T ) CALL LAPACK_GEMM( 'N', 'T', 1.0_ReKi, p%PhiM, p%PhiM, 0.0_ReKi, p%D2_64, ErrStat2, ErrMsg2 ); if(Failed()) return; - - ! F2_61 - p%F2_61 = MATMUL( p%D2_64, FGL ) !Now calculate a Jacobian used when AM2 is called and store in parameters IF (p%IntMethod .EQ. 4) THEN ! Allocate Jacobian if AM2 is requested & if there are states (p%nDOFM > 0) @@ -2531,15 +2548,11 @@ SUBROUTINE SetParameters(Init, p, MBBb, MBmb, KBBb, PhiRb, nM_out, OmegaL, PhiL, write(Info,'(3x,A,F8.5,A,F8.5,A,F8.5)') 'SubDyn recommended dt:',dt_max, ' - Current dt:', p%SDDeltaT,' - Max frequency:', freq_max call WrScr(Info) ELSE ! no retained modes, so - ! OmegaM, JDampings, PhiM, MBM, MMB, FX , x don't exist in this case - ! p%F2_61, p%D2_64 are zero in this case so we simplify the equations in the code, omitting these variables + ! OmegaM, JDampings, PhiM, MBM, MMB, x don't exist in this case + ! p%D2_64 are zero in this case so we simplify the equations in the code, omitting these variables ! p%D2_63 = p%PhiRb_TI in this case so we simplify the equations in the code, omitting storage of this variable - p%D1_12 = p%CBB ! No cross couplings - p%D1_13 = p%MBB ! No cross couplings - p%D1_14 = - MATMUL( TI_transpose, TRANSPOSE(PHiRb)) - - ! FY (with 0 retained modes) - p%FY = - MATMUL( TI_transpose, FGB ) + p%D1_141 = 0.0_ReKi + p%D1_142 = - MATMUL(TI_transpose, TRANSPOSE(PhiRb)) END IF CONTAINS @@ -2568,8 +2581,8 @@ SUBROUTINE AllocParameters(p, nDOFM, ErrStat, ErrMsg) CALL AllocAry( p%CBB, nDOFL_TP, nDOFL_TP, 'p%CBB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%MBB, nDOFL_TP, nDOFL_TP, 'p%MBB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%TI, p%nDOFI__, 6, 'p%TI', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%D1_14, nDOFL_TP, p%nDOF__L,'p%D1_14', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%FY, nDOFL_TP, 'p%FY', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') + CALL AllocAry( p%D1_141, nDOFL_TP, p%nDOF__L,'p%D1_141', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') + CALL AllocAry( p%D1_142, nDOFL_TP, p%nDOF__L,'p%D1_142', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%PhiRb_TI, p%nDOF__L, nDOFL_TP,'p%PhiRb_TI', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') @@ -2578,19 +2591,14 @@ SUBROUTINE AllocParameters(p, nDOFM, ErrStat, ErrMsg) CALL AllocAry( p%MMB, nDOFM, nDOFL_TP, 'p%MMB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%KMMDiag, nDOFM, 'p%KMMDiag', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%CMMDiag, nDOFM, 'p%CMMDiag', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%CMB, nDOFM, nDOFL_TP, 'p%CMB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%CBM, nDOFL_TP, nDOFM, 'p%CBM', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%FX, nDOFM, 'p%FX', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%C1_11, nDOFL_TP, nDOFM, 'p%C1_11', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%C1_12, nDOFL_TP, nDOFM, 'p%C1_12', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%PhiM, p%nDOF__L, nDOFM, 'p%PhiM', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%C2_61, p%nDOF__L, nDOFM, 'p%C2_61', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') CALL AllocAry( p%C2_62, p%nDOF__L, nDOFM, 'p%C2_62', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') - CALL AllocAry( p%D1_12, nDOFL_TP, nDOFL_TP , 'p%D1_12', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is p%MBB when p%nDOFM == 0 - CALL AllocAry( p%D1_13, nDOFL_TP, nDOFL_TP , 'p%D1_13', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is p%MBB when p%nDOFM == 0 + CALL AllocAry( p%MBmmB, nDOFL_TP, nDOFL_TP , 'p%MBmmB', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is p%MBB when p%nDOFM == 0 CALL AllocAry( p%D2_63, p%nDOF__L, nDOFL_TP, 'p%D2_63', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is p%PhiRb_TI when p%nDOFM == 0 CALL AllocAry( p%D2_64, p%nDOF__L, p%nDOF__L,'p%D2_64', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is zero when p%nDOFM == 0 - CALL AllocAry( p%F2_61, p%nDOF__L, 'p%F2_61', ErrStat2, ErrMsg2 ); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocParameters') ! is zero when p%nDOFM == 0 end if END SUBROUTINE AllocParameters @@ -2610,7 +2618,7 @@ SUBROUTINE AllocMiscVars(p, Misc, ErrStat, ErrMsg) ErrMsg = "" ! for readability, we're going to keep track of the max ErrStat through SetErrStat() and not return until the end of this routine. - CALL AllocAry( Misc%UFL, p%nDOF__L, 'UFL', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') + CALL AllocAry( Misc%F_L, p%nDOF__L, 'F_L', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%UR_bar, p%nDOFI__, 'UR_bar', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') !TODO Rb CALL AllocAry( Misc%UR_bar_dot, p%nDOFI__, 'UR_bar_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') !TODO Rb CALL AllocAry( Misc%UR_bar_dotdot,p%nDOFI__, 'UR_bar_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') !TODO Rb @@ -2622,9 +2630,9 @@ SUBROUTINE AllocMiscVars(p, Misc, ErrStat, ErrMsg) CALL AllocAry( Misc%U_full_elast, p%nDOF, 'U_full_elast', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_dot, p%nDOF, 'U_full_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%U_full_dotdot,p%nDOF, 'U_full_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red, p%nDOF_red,'U_red', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red_dot, p%nDOF_red,'U_red_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') - CALL AllocAry( Misc%U_red_dotdot, p%nDOF_red,'U_red_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') + CALL AllocAry( Misc%U_red, p%nDOF_red, 'U_red', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') + CALL AllocAry( Misc%U_red_dot, p%nDOF_red, 'U_red_dot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') + CALL AllocAry( Misc%U_red_dotdot, p%nDOF_red, 'U_red_dotdot', ErrStat2, ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%Fext, p%nDOF , 'm%Fext ', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') CALL AllocAry( Misc%Fext_red, p%nDOF_red , 'm%Fext_red', ErrStat2, ErrMsg2 );CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'AllocMiscVars') @@ -2885,75 +2893,139 @@ END SUBROUTINE CleanUp END SUBROUTINE PartitionDOFNodes +!> Compute displacements of all nodes in global system (Guyan + Rotated CB) +!! +SUBROUTINE LeverArm(u, p, x, m, DU_full, bGuyan, bElastic, U_full) + TYPE(SD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SD_ParameterType),target,INTENT(IN ) :: p !< Parameters + TYPE(SD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(SD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + LOGICAL, INTENT(IN ) :: bGuyan !< include Guyan Contribution + LOGICAL, INTENT(IN ) :: bElastic !< include Elastic contribution + REAL(ReKi), DIMENSION(:), INTENT( OUT) :: DU_full !< LeverArm in full system + REAL(ReKi), DIMENSION(:), OPTIONAL, INTENT(IN ) :: U_full !< Displacements in full system + !locals + INTEGER(IntKi) :: iSDNode + REAL(ReKi) :: rotations(3) + INTEGER(IntKi), pointer :: DOFList(:) + ! Variables for Guyan rigid body motion + real(ReKi), dimension(3) :: rIP ! Vector from TP to rotated Node + real(ReKi), dimension(3) :: rIP0 ! Vector from TP to Node (undeflected) + real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation + real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global coordinates + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + ! --- Convert inputs to FEM DOFs and convenient 6-vector storage + ! Compute the small rotation angles given the input direction cosine matrix + rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat2, Errmsg2); + m%u_TP = (/REAL(u%TPMesh%TranslationDisp(:,1),ReKi), rotations/) + + if (present(U_full)) then + ! Then we use it directly, U_full may contain Static improvement + DU_full=U_full + ! We remove u_TP for floating + if (p%Floating) then + do iSDNode = 1,p%nNodes + DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + DU_full(DOFList(1:3)) = DU_full(DOFList(1:3)) - m%u_TP(1:3) + enddo + endif + else + ! --- CB modes contribution to motion (L-DOF only), NO STATIC IMPROVEMENT + if (bElastic .and. p%nDOFM > 0) then + m%UL = matmul( p%PhiM, x%qm ) + else + m%UL = 0.0_ReKi + end if + ! --- Adding Guyan contribution to R and L DOFs + if (bGuyan .and. .not.p%Floating) then + m%UR_bar = matmul( p%TI , m%u_TP ) + m%UL = m%UL + matmul( p%PhiRb_TI, m%u_TP ) + else + ! Guyan modes are rigid body modes, we will add them in the "Full system" later + m%UR_bar = 0.0_ReKi + endif + ! --- Build original DOF vectors (DOF before the CB reduction) + m%U_red(p%IDI__) = m%UR_bar + m%U_red(p%ID__L) = m%UL + m%U_red(p%IDC_Rb)= 0 ! NOTE: for now we don't have leader DOF at "C" (bottom) + m%U_red(p%ID__F) = 0 + if (p%reduced) then + DU_full = matmul(p%T_red, m%U_red) + else + DU_full = m%U_red + endif + ! --- Adding Guyan contribution for rigid body + if (bGuyan .and. p%Floating) then + ! For floating, we compute the Guyan motion directly (rigid body motion with TP as origin) + ! This introduce non-linear "rotations" effects, where the bottom node should "go up", and not just translate horizontally + Rb2g(1:3,1:3) = transpose(u%TPMesh%Orientation(:,:,1)) + do iSDNode = 1,p%nNodes + DOFList => p%NodesDOF(iSDNode)%List ! Alias to shorten notations + ! --- Guyan (rigid body) motion in global coordinates + rIP0(1:3) = p%DP0(1:3, iSDNode) + rIP(1:3) = matmul(Rb2g, rIP0) + duP(1:3) = rIP - rIP0 ! NOTE: without m%u_TP(1:3) + !DU_full(DOFList(1:3)) = DU_full(DOFList(1:3)) + duP(1:3) + !DU_full(DOFList(4:6)) = DU_full(DOFList(4:6)) + rotations(1:3) + ! Full diplacements Guyan + rotated CB (if asked) >>> Rotate All + DU_full(DOFList(1:3)) = matmul(Rb2g, DU_full(DOFList(1:3))) + duP(1:3) + DU_full(DOFList(4:6)) = matmul(Rb2g, DU_full(DOFList(4:6))) + rotations(1:3) + enddo + endif + endif ! U_full no provided +END SUBROUTINE LeverArm + !------------------------------------------------------------------------------------------------------ !> Construct force vector on internal DOF (L) from the values on the input mesh !! First, the full vector of external forces is built on the non-reduced DOF !! Then, the vector is reduced using the Tred matrix -SUBROUTINE GetExtForceOnInternalDOF( u, p, m, F_L, ErrStat, ErrMsg ) +SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, ExtraMoment, RotateLoads, U_full) type(SD_InputType), intent(in ) :: u ! Inputs type(SD_ParameterType), intent(in ) :: p ! Parameters + type(SD_ContinuousStateType), intent(in ) :: x !< Continuous states at t type(SD_MiscVarType), intent(inout) :: m ! Misc, for storage optimization of Fext and Fext_red + logical , intent(in ) :: ExtraMoment ! If true add extra moment + logical , intent(in ) :: RotateLoads ! If true, loads are rotated to body coordinate + real(Reki), optional, intent(in ) :: U_full(:) ! DOF displacements (Guyan + CB) real(ReKi) , intent(out) :: F_L(p%nDOF__L) !< External force on internal nodes "L" integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer :: iNode ! indices of u-mesh nodes and SD nodes integer :: nMembers - integer :: startDOF, I + integer :: I integer :: iCC, iElem, iChannel !< Index on control cables, element, Channel integer(IntKi), dimension(12) :: IDOF ! 12 DOF indices in global unconstrained system real(ReKi) :: CableTension ! Controllable Cable force real(ReKi) :: rotations(3) real(ReKi) :: du(3), Moment(3), Force(3) + real(ReKi) :: u_TP(6) ! Variables for Guyan Rigid motion real(ReKi), dimension(3) :: rIP ! Vector from TP to rotated Node real(ReKi), dimension(3) :: rIP0 ! Vector from TP to Node (undeflected) real(ReKi), dimension(3) :: duP ! Displacement of node due to rigid rotation - real(R8Ki), dimension(3,3) :: Rot ! Rotation matrix (DCM^t) and delta Rot (DCM^t-I) + real(R8Ki), dimension(3,3) :: Rb2g ! Rotation matrix body 2 global + real(R8Ki), dimension(3,3) :: Rg2b ! Rotation matrix global 2 body coordinates ! real(ReKi), parameter :: myNaN = -9999998.989_ReKi - if (p%ExtraMoment) then - ! --- Compute Guyan displacement for extra moment (similar to CalcOutput, but wihtout CB) - rotations = GetSmllRotAngs(u%TPMesh%Orientation(:,:,1), ErrStat, Errmsg); - if (p%Floating .and. GUYAN_RIGID_FLOATING) then - ! For fully floating case, we prescribe the Guyan motion as a "rigid" (non-linear) motion - Rot(1:3,1:3) = transpose(u%TPMesh%Orientation(:,:,1)) - m%DU_full = 0.0_ReKi - do iNode = 1,p%nNodes - rIP0(1:3) = p%DP0(1:3, iNode) ! vector interface->node at t=0 - rIP(1:3) = matmul(Rot, rIP0) ! vector interface->node at t - duP(1:3) = rIP - rIP0 ! nodal rigid displacement (without u_TP) - m%DU_full(p%NodesDOF(iNode)%List(1:3)) = duP(1:3) - enddo - else - ! For other cases with use the computed (linear) Guyan motion - m%u_TP = (/REAL(u%TPMesh%TranslationDisp(:,1),ReKi), rotations/) - m%UR_bar = matmul( p%TI , m%u_TP ) ! UR_bar - m%UL = matmul( p%PhiRb_TI, m%u_TP ) ! UL - m%U_red(p%IDI__) = m%UR_bar - m%U_red(p%ID__L) = m%UL - m%U_red(p%IDC_Rb)= 0 ! TODO - m%U_red(p%ID__F) = 0 - if (p%reduced) then - m%DU_full = matmul(p%T_red, m%U_red) - else - m%DU_full = m%U_red - endif - if (.not.p%FixedBottom) then ! if Floating, remove u_TP translation - do iNode = 1,p%nNodes - m%DU_full(p%NodesDOF(iNode)%List(1:3)) = m%DU_full(p%NodesDOF(iNode)%List(1:3)) - m%u_TP(1:3) - enddo - endif - endif + if (ExtraMoment) then + ! Compute node displacements "DU_full" for lever arm + call LeverArm(u, p, x, m, m%DU_full, bGuyan=.True., bElastic=.False., U_full=U_full) endif - - ! --- Build vector of external forces (Moment done below) + ! --- Build vector of external forces (including gravity) (Moment done below) m%Fext= myNaN - DO iNode = 1,p%nNodes - ! Force - All nodes have only 3 translational DOFs - m%Fext( p%NodesDOF(iNode)%List(1:3) ) = u%LMesh%Force (:,iNode) - enddo + if (RotateLoads) then ! Forces in body coordinates + Rg2b(1:3,1:3) = u%TPMesh%Orientation(:,:,1) ! global 2 body coordinates + do iNode = 1,p%nNodes + m%Fext( p%NodesDOF(iNode)%List(1:3) ) = matmul(Rg2b, u%LMesh%Force(:,iNode) + p%FG(p%NodesDOF(iNode)%List(1:3))) + enddo + else ! Forces in global + do iNode = 1,p%nNodes + m%Fext( p%NodesDOF(iNode)%List(1:3) ) = u%LMesh%Force(:,iNode) + p%FG(p%NodesDOF(iNode)%List(1:3)) + enddo + endif ! --- Adding controllable cable forces if (size(p%CtrlElem2Channel,1) > 0) then @@ -2969,26 +3041,37 @@ SUBROUTINE GetExtForceOnInternalDOF( u, p, m, F_L, ErrStat, ErrMsg ) IDOF = p%ElemsDOF(1:12, iElem) ! T(t) = - EA * DeltaL(t) /(Le + Delta L(t)) ! NOTE DeltaL<0 CableTension = -p%ElemProps(iElem)%YoungE*p%ElemProps(iElem)%Area * u%CableDeltaL(iChannel) / (p%ElemProps(iElem)%Length + u%CableDeltaL(iChannel)) - m%Fext(IDOF) = m%Fext(IDOF) + m%FC_unit( IDOF ) * (CableTension - p%ElemProps(iElem)%T0) + print*,'TODO, Controllable pretension cable needs thinking for moment' + STOP + !if (RotateLoads) then ! in body coordinate + ! m%Fext(IDOF) = m%Fext(IDOF) + matmul(Rg2b,m%FC_unit( IDOF ) * (CableTension - p%ElemProps(iElem)%T0)) + !else ! in global + ! m%Fext(IDOF) = m%Fext(IDOF) + m%FC_unit( IDOF ) * (CableTension - p%ElemProps(iElem)%T0) + !endif enddo endif ! --- Build vector of external moment - DO iNode = 1,p%nNodes + do iNode = 1,p%nNodes Force(1:3) = m%Fext(p%NodesDOF(iNode)%List(1:3) ) ! Controllable cable + External Forces on LMesh - Moment(1:3) = u%LMesh%Moment(1:3,iNode) - nMembers = (size(p%NodesDOF(iNode)%List)-3)/3 ! Number of members deducted from Node's DOFList + ! Moment ext + gravity + if (RotateLoads) then + ! In body coordinates + Moment(1:3) = matmul(Rg2b, u%LMesh%Moment(1:3,iNode) + p%FG(p%NodesDOF(iNode)%List(4:6))) + else + Moment(1:3) = u%LMesh%Moment(1:3,iNode) + p%FG(p%NodesDOF(iNode)%List(4:6)) + endif ! Extra moment dm = Delta u x (fe + fg) - if (p%ExtraMoment) then - Force = Force + p%FG_full(p%NodesDOF(iNode)%List(1:3)) ! Adding gravity and initial cable - du = m%DU_full(p%NodesDOF(iNode)%List(1:3)) ! Lever arm + if (ExtraMoment) then + du = m%DU_full(p%NodesDOF(iNode)%List(1:3)) ! Lever arm Moment(1) = Moment(1) + du(2) * Force(3) - du(3) * Force(2) Moment(2) = Moment(2) + du(3) * Force(1) - du(1) * Force(3) Moment(3) = Moment(3) + du(1) * Force(2) - du(2) * Force(1) endif ! Moment is spread equally across all rotational DOFs if more than 3 rotational DOFs + nMembers = (size(p%NodesDOF(iNode)%List)-3)/3 ! Number of members deducted from Node's DOFList m%Fext( p%NodesDOF(iNode)%List(4::3)) = Moment(1)/nMembers m%Fext( p%NodesDOF(iNode)%List(5::3)) = Moment(2)/nMembers m%Fext( p%NodesDOF(iNode)%List(6::3)) = Moment(3)/nMembers @@ -3349,8 +3432,8 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, ErrStat,ErrMsg) ! --- write assembed GRAVITY FORCE FG VECTOR. gravity forces applied at each node of the full system WRITE(UnSum, '(A)') SectionDivide - WRITE(UnSum, '(A)') '#Initial gravity and cable loads applied at each node of the system (after DOF elimination with T matrix)' - call yaml_write_array(UnSum, 'FG', Init%FG, ReFmt, ErrStat2, ErrMsg2, comment='') + WRITE(UnSum, '(A)') '#Gravity and cable loads applied at each node of the system (before DOF elimination with T matrix)' + call yaml_write_array(UnSum, 'FG', p%FG, ReFmt, ErrStat2, ErrMsg2, comment='') ! --- write CB system matrices WRITE(UnSum, '(A)') SectionDivide @@ -3358,8 +3441,6 @@ SUBROUTINE OutSummary(Init, p, m, InitInput, CBparams, ErrStat,ErrMsg) call yaml_write_array(UnSum, 'MBB ',CBparams%MBB, ReFmt, ErrStat2, ErrMsg2, comment='') call yaml_write_array(UnSum, 'MBM', CBparams%MBM, ReFmt, ErrStat2, ErrMsg2, comment='') !call yaml_write_array(UnSum, 'CBB', CBparams%CBB, ReFmt, ErrStat2, ErrMsg2, comment='') - !call yaml_write_array(UnSum, 'CBM', CBparams%CBM, ReFmt, ErrStat2, ErrMsg2, comment='') - !call yaml_write_array(UnSum, 'CBMt',p%CBM, ReFmt, ErrStat2, ErrMsg2, comment='(at TP)') !call yaml_write_array(UnSum, 'CMM', CBparams%CMM, ReFmt, ErrStat2, ErrMsg2, comment='') !call yaml_write_array(UnSum, 'CMMdiag_zeta',2.0_ReKi * CBparams%OmegaL(1:p%nDOFM) * Init%JDampings(1:p%nDOFM) , ReFmt, ErrStat2, ErrMsg2, comment='(2ZetaOmegaM)') call yaml_write_array(UnSum, 'CMMdiag',p%CMMDiag, ReFmt, ErrStat2, ErrMsg2, comment='(2 Zeta OmegaM)') @@ -3409,7 +3490,7 @@ SUBROUTINE CleanUp() END SUBROUTINE CleanUp END SUBROUTINE OutSummary -SUBROUTINE StateMatrices(p, ErrStat, ErrMsg, AA, BB, CC, DD) +SUBROUTINE StateMatrices(p, ErrStat, ErrMsg, AA, BB, CC, DD, u) type(SD_ParameterType), intent(in) :: p !< Parameters integer(IntKi), intent(out) :: ErrStat !< Error status of the operation character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3417,6 +3498,7 @@ SUBROUTINE StateMatrices(p, ErrStat, ErrMsg, AA, BB, CC, DD) real(R8Ki), dimension(:,:), allocatable, optional :: BB !< real(R8Ki), dimension(:,:), allocatable, optional :: CC !< real(R8Ki), dimension(:,:), allocatable, optional :: DD !< + type(SD_InputType), intent(in), optional :: u !< Inputs integer(IntKi) :: nU, nX, nY, nCB, i, j, iNode, iOff, k, nMembers, iField real(R8Ki), dimension(:), allocatable :: dFext_dFmeshk real(R8Ki), dimension(:), allocatable :: dFred_dFmeshk @@ -3453,8 +3535,7 @@ SUBROUTINE StateMatrices(p, ErrStat, ErrMsg, AA, BB, CC, DD) call AllocAry(BB, nX, nU, 'BB', ErrStat2, ErrMsg2 ); if(Failed()) return; BB(:,:) = 0.0_ReKi if(nCB>0) then BB(nCB+1:nX, 1 :6 ) = 0.0_ReKi - BB(nCB+1:nX, 7:12 ) = -p%CMB(1:nCB,1:6) - BB(nCB+1:nX, 13:18 ) = -p%MMB(1:nCB,1:6) + BB(nCB+1:nX, 13:18 ) = -p%MMB(1:nCB,1:6) ! TODO rotate call AllocAry(dFext_dFmeshk, p%nDOF , 'dFext', ErrStat2, ErrMsg2 ); if(Failed()) return call AllocAry(dFred_dFmeshk, p%nDOF_red , 'dFred', ErrStat2, ErrMsg2 ); if(Failed()) return call AllocAry(dFL_dFmeshk , p%nDOF__L , 'dFl' , ErrStat2, ErrMsg2 ); if(Failed()) return @@ -3499,6 +3580,10 @@ SUBROUTINE StateMatrices(p, ErrStat, ErrMsg, AA, BB, CC, DD) if (nCB>0) then CC(1:nY,1:nCB ) = - p%C1_11 CC(1:nY,nCB+1:nX) = - p%C1_12 + if (p%Floating .and. present(u)) then + CC(1:3,:) = matmul(transpose(u%TPMesh%Orientation(:,:,1)), CC(1:3,:)) ! >>> Rotate All + CC(4:6,:) = matmul(transpose(u%TPMesh%Orientation(:,:,1)), CC(4:6,:)) ! >>> Rotate All + endif endif endif @@ -3508,8 +3593,17 @@ SUBROUTINE StateMatrices(p, ErrStat, ErrMsg, AA, BB, CC, DD) if(allocated(DD)) deallocate(DD) call AllocAry(DD, nY, nU, 'DD', ErrStat2, ErrMsg2 ); if(Failed()) return; DD(:,:) = 0.0_ReKi DD(1:nY,1:6 ) = - p%KBB - DD(1:nY,7:12 ) = - p%D1_12 - DD(1:nY,13:18 ) = - p%D1_13 + DD(1:nY,7:12 ) = - p%CBB + DD(1:nY,13:18 ) = - p%MBB + if (p%nDOFM>0) then + if (p%Floating .and. present(u)) then + ! TODO TODO rotate it A MBmmB A^t + !DD(1:3,:) = DD(1:3,:) + matmul(transpose(u%TPMesh%Orientation(:,:,1)), p%MBmmB(1:3,:) ! >>> Rotate All + DD(1:nY,13:18 ) = DD(1:nY,13:18 )+ p%MBmmB + else + DD(1:nY,13:18 ) = DD(1:nY,13:18 )+ p%MBmmB + endif + endif endif call CleanUp() diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index 3af761d34f..49c3a201da 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -4,299 +4,279 @@ # Use ^ as a shortcut for the value in the same column from the previous line. ################################################################################################################################### # ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt +include Registry_NWTC_Library.txt -# -# Keyword ModuleName/ModName Derived data type Field type Variable name Dimemsion of the variable Initial value not used Description Units - -typedef SubDyn/SD IList INTEGER List {:} - - "List of integers" +# ============================== Internal data types ============================================================================================================================================ +typedef SubDyn/SD IList INTEGER List {:} - - "List of integers" +# +typedef ^ MeshAuxDataType INTEGER MemberID - - - "Member ID for Output" +typedef ^ MeshAuxDataType INTEGER NOutCnt - - - "Number of Nodes for the output member" +typedef ^ MeshAuxDataType INTEGER NodeCnt {:} - - "Node ordinal numbers for the output member" +typedef ^ MeshAuxDataType INTEGER NodeIDs {:} - - "Node IDs associated with ordinal numbers for the output member" +typedef ^ MeshAuxDataType INTEGER ElmIDs {:}{:} - - "Element IDs connected to each NodeIDs; max 10 elements" +typedef ^ MeshAuxDataType INTEGER ElmNds {:}{:} - - "Flag to indicate 1st or 2nd node of element for each ElmIDs" +typedef ^ MeshAuxDataType R8Ki Me {:}{:}{:}{:} - - "Mass matrix connected to each joint element for outAll output" +typedef ^ MeshAuxDataType R8Ki Ke {:}{:}{:}{:} - - "Mass matrix connected to each joint element for outAll output" +typedef ^ MeshAuxDataType R8Ki Fg {:}{:}{:} - - "Gravity load vector connected to each joint element for requested member output" -! integer, dimension(:), pointer :: data => null() -! type(IList), pointer :: next => null() +# CB_MatArrays: Matrices and arrays for CB summary +typedef ^ CB_MatArrays R8Ki MBB {:}{:} - - "FULL MBB ( no constraints applied)" +typedef ^ CB_MatArrays R8Ki MBM {:}{:} - - "FULL MBM ( no constraints applied)" +typedef ^ CB_MatArrays R8Ki KBB {:}{:} - - "FULL KBB ( no constraints applied)" +typedef ^ CB_MatArrays R8Ki PhiL {:}{:} - - "Retained CB modes, possibly allPhiL(nDOFL,nDOFL), or PhiL(nDOFL,nDOFM)" +typedef ^ CB_MatArrays R8Ki PhiR {:}{:} - - "FULL PhiR ( no constraints applied)" +typedef ^ CB_MatArrays R8Ki OmegaL {:} - - "Eigenvalues of retained CB modes, possibly all (nDOFL or nDOFM)" +# +typedef ^ ElemPropType IntKi eType - - - "Element Type" +typedef ^ ElemPropType ReKi Length - - - "Length of an element" +typedef ^ ElemPropType ReKi Ixx - - - "Moment of inertia of an element" +typedef ^ ElemPropType ReKi Iyy - - - "Moment of inertia of an element" +typedef ^ ElemPropType ReKi Jzz - - - "Moment of inertia of an element" +typedef ^ ElemPropType LOGICAL Shear - - - "Use timoshenko (true) E-B (false)" +typedef ^ ElemPropType ReKi Kappa - - - "Shear coefficient" +typedef ^ ElemPropType ReKi YoungE - - - "Young's modulus" +typedef ^ ElemPropType ReKi ShearG - - - "Shear modulus" N/m^2 +# Properties common to all element types: +typedef ^ ElemPropType ReKi Area - - - "Area of an element" m^2 +typedef ^ ElemPropType ReKi Rho - - - "Density" kg/m^3 +typedef ^ ElemPropType ReKi T0 - - - "Pretension " N +typedef ^ ElemPropType R8Ki DirCos {3}{3} - - "Element direction cosine matrix" -# ============================== Define Initialization Inputs (from glue code) here: ============================================================================================================================================ -typedef SubDyn/SD InitInputType CHARACTER(1024) SDInputFile - - - "Name of the input file" -typedef ^ InitInputType CHARACTER(1024) RootName - - - "SubDyn rootname" -typedef ^ InitInputType ReKi g - - - "Gravity acceleration" -typedef ^ InitInputType ReKi WtrDpth - - - "Water Depth (positive valued)" -typedef ^ InitInputType ReKi TP_RefPoint {3} - - "global position of transition piece reference point (could also be defined in SubDyn itself)" -typedef ^ InitInputType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" -typedef ^ InitInputType ReKi SoilStiffness ::: - - "Soil stiffness matrices from SoilDyn" '(N/m, N-m/rad)' -typedef ^ InitInputType MeshType SoilMesh - - - "Mesh for soil stiffness locations" - -typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +# ============================== Input Initialization (from glue code) ============================================================================================================================================ +typedef ^ InitInputType CHARACTER(1024) SDInputFile - - - "Name of the input file" +typedef ^ InitInputType CHARACTER(1024) RootName - - - "SubDyn rootname" +typedef ^ InitInputType ReKi g - - - "Gravity acceleration" +typedef ^ InitInputType ReKi WtrDpth - - - "Water Depth (positive valued)" +typedef ^ InitInputType ReKi TP_RefPoint {3} - - "global position of transition piece reference point (could also be defined in SubDyn itself)" +typedef ^ InitInputType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" +typedef ^ InitInputType ReKi SoilStiffness ::: - - "Soil stiffness matrices from SoilDyn" '(N/m, N-m/rad)' +typedef ^ InitInputType MeshType SoilMesh - - - "Mesh for soil stiffness locations" - +typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - -# ============================== Define Initialization outputs here: ============================================================================================================================================ -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ ^ ProgDesc Ver - - - "This module's name, version, and date" - +# ============================== Initialization outputs ============================================================================================================================================ +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - # Linearization -typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ ^ CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - -typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ ^ LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue)" - -typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - -typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - +typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - +typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue)" - +typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ InitOutputType IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - -# ============================== Define Internal data types here: ============================================================================================================================================ -typedef SubDyn/SD MeshAuxDataType INTEGER MemberID - - - "Member ID for Output" -typedef ^ MeshAuxDataType INTEGER NOutCnt - - - "Number of Nodes for the output member" -typedef ^ MeshAuxDataType INTEGER NodeCnt {:} - - "Node ordinal numbers for the output member" -typedef ^ MeshAuxDataType INTEGER NodeIDs {:} - - "Node IDs associated with ordinal numbers for the output member" -typedef ^ MeshAuxDataType INTEGER ElmIDs {:}{:} - - "Element IDs connected to each NodeIDs; max 10 elements" -typedef ^ MeshAuxDataType INTEGER ElmNds {:}{:} - - "Flag to indicate 1st or 2nd node of element for each ElmIDs" -typedef ^ MeshAuxDataType R8Ki Me {:}{:}{:}{:} - - "Mass matrix connected to each joint element for outAll output" -typedef ^ MeshAuxDataType R8Ki Ke {:}{:}{:}{:} - - "Mass matrix connected to each joint element for outAll output" -typedef ^ MeshAuxDataType R8Ki Fg {:}{:}{:} - - "Gravity load vector connected to each joint element for requested member output" -# CB_MatArrays: Matrices and arrays for CB summary -typedef ^ CB_MatArrays R8Ki MBB {:}{:} - - "FULL MBB ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki MBM {:}{:} - - "FULL MBM ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki KBB {:}{:} - - "FULL KBB ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki PhiL {:}{:} - - "Retained CB modes, possibly allPhiL(nDOFL,nDOFL), or PhiL(nDOFL,nDOFM)" -typedef ^ CB_MatArrays R8Ki PhiR {:}{:} - - "FULL PhiR ( no constraints applied)" -typedef ^ CB_MatArrays R8Ki OmegaL {:} - - "Eigenvalues of retained CB modes, possibly all (nDOFL or nDOFM)" -# -typedef ^ ElemPropType IntKi eType - - - "Element Type" -typedef ^ ^ ReKi Length - - - "Length of an element" -typedef ^ ^ ReKi Ixx - - - "Moment of inertia of an element" -typedef ^ ^ ReKi Iyy - - - "Moment of inertia of an element" -typedef ^ ^ ReKi Jzz - - - "Moment of inertia of an element" -typedef ^ ^ LOGICAL Shear - - - "Use timoshenko (true) E-B (false)" -typedef ^ ^ ReKi Kappa - - - "Shear coefficient" -typedef ^ ^ ReKi YoungE - - - "Young's modulus" -typedef ^ ^ ReKi ShearG - - - "Shear modulus" N/m^2 -# Properties common to all element types: -typedef ^ ^ ReKi Area - - - "Area of an element" m^2 -typedef ^ ^ ReKi Rho - - - "Density" kg/m^3 -typedef ^ ^ ReKi T0 - - - "Pretension " N -typedef ^ ^ R8Ki DirCos {3}{3} - - "Element direction cosine matrix" # ============================== Define initialization data (not from glue code) here: ============================================================================================================================================ -#--------------------------arrays and variables from the input file --------------------------------------------------------------------------------------------------------------------------------- -typedef SubDyn/SD SD_InitType CHARACTER(1024) RootName - - - "SubDyn rootname" -typedef ^ ^ ReKi TP_RefPoint {3} - - "global position of transition piece reference point (could also be defined in SubDyn itself)" -typedef ^ ^ ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" -typedef ^ ^ ReKi g - - - "Gravity acceleration" -typedef ^ ^ DbKi DT - - - "Time step from Glue Code" seconds -typedef ^ ^ INTEGER NJoints - - - "Number of joints of the sub structure" -typedef ^ ^ INTEGER NPropSetsX - - - "Number of extended property sets" -typedef ^ ^ INTEGER NPropSetsB - - - "Number of property sets for beams" -typedef ^ ^ INTEGER NPropSetsC - - - "Number of property sets for cables" -typedef ^ ^ INTEGER NPropSetsR - - - "Number of property sets for rigid links" -typedef ^ ^ INTEGER NCMass - - - "Number of joints with concentrated mass" -typedef ^ ^ INTEGER NCOSMs - - - "Number of independent cosine matrices" -typedef ^ ^ INTEGER FEMMod - - - "FEM switch element model in the FEM" -typedef ^ ^ INTEGER NDiv - - - "Number of divisions for each member" -typedef ^ ^ LOGICAL CBMod - - - "Perform C-B flag" -typedef ^ ^ ReKi Joints {:}{:} - - "Joints number and coordinate values" -typedef ^ ^ ReKi PropSetsB {:}{:} - - "Property sets number and values" -typedef ^ ^ ReKi PropSetsC {:}{:} - - "Property ID and values for cables" -typedef ^ ^ ReKi PropSetsR {:}{:} - - "Property ID and values for rigid link" -typedef ^ ^ ReKi PropSetsX {:}{:} - - "Extended property sets" -typedef ^ ^ ReKi COSMs {:}{:} - - "Independent direction cosine matrices" -typedef ^ ^ ReKi CMass {:}{:} - - "Concentrated mass information" -typedef ^ ^ ReKi JDampings {:} - - "Damping coefficients for internal modes" -typedef ^ ^ IntKi GuyanDampMod - - - "Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix]" -typedef ^ ^ ReKi RayleighDamp {2} - - "Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1]" -typedef ^ ^ ReKi GuyanDampMat {6}{6} - - "Guyan Damping Matrix, see also CBB" -typedef ^ ^ INTEGER Members {:}{:} - - "Member joints connection" -typedef ^ ^ CHARACTER(ChanLen) SSOutList {:} - - "List of Output Channels" -typedef ^ ^ LOGICAL OutCOSM - - - "Output Cos-matrices Flag" -typedef ^ ^ LOGICAL TabDelim - - - "Generate a tab-delimited output file in OutJckF-Flag" -typedef ^ ^ R8Ki SSIK {:}{:} - - "SSI stiffness packed matrix elements (21 of them), for each reaction joint" -typedef ^ ^ R8Ki SSIM {:}{:} - - "SSI mass packed matrix elements (21 of them), for each reaction joint" -typedef ^ ^ CHARACTER(1024) SSIfile {:} - - "Soil Structure Interaction (SSI) files to associate with each reaction node" -typedef ^ ^ ReKi Soil_K {:}{:}{:} - - "Soil stiffness (at passed at Init, not in input file) 6x6xn" -typedef ^ ^ ReKi Soil_Points {:}{:} - - "Node positions where soil stiffness will be added" -typedef ^ ^ Integer Soil_Nodes {:} - - "Node indices where soil stiffness will be added" -#-------------------------- arrays and variables used in the module ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ -typedef ^ ^ INTEGER NElem - - - "Total number of elements" -typedef ^ ^ INTEGER NPropB - - - "Total number of property sets for Beams" -typedef ^ ^ INTEGER NPropC - - - "Total number of property sets for Cable" -typedef ^ ^ INTEGER NPropR - - - "Total number of property sets for Rigid" -typedef ^ ^ ReKi Nodes {:}{:} - - "Nodes number and coordinates" -typedef ^ ^ ReKi PropsB {:}{:} - - "Property sets and values for Beams" -typedef ^ ^ ReKi PropsC {:}{:} - - "Property sets and values for Cable" -typedef ^ ^ ReKi PropsR {:}{:} - - "Property sets and values for Rigid link" -typedef ^ ^ R8Ki K {:}{:} - - "System stiffness matrix" -typedef ^ ^ R8Ki M {:}{:} - - "System mass matrix" -typedef ^ ^ R8Ki FG {:} - - "Gravity force vector (include initial Cable force T0)" N -typedef ^ ^ ReKi ElemProps {:}{:} - - "Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) )" -typedef ^ ^ INTEGER MemberNodes {:}{:} - - "Member number and list of nodes making up a member (>2 if subdivided)" -typedef ^ ^ INTEGER NodesConnN {:}{:} - - "Nodes that connect to a common node" -typedef ^ ^ INTEGER NodesConnE {:}{:} - - "Elements that connect to a common node" -typedef ^ ^ LOGICAL SSSum - - - "SubDyn Summary File Flag" +typedef ^ SD_InitType CHARACTER(1024) RootName - - - "SubDyn rootname" +typedef ^ SD_InitType ReKi TP_RefPoint {3} - - "global position of transition piece reference point (could also be defined in SubDyn itself)" +typedef ^ SD_InitType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" +typedef ^ SD_InitType ReKi g - - - "Gravity acceleration" +typedef ^ SD_InitType DbKi DT - - - "Time step from Glue Code" seconds +typedef ^ SD_InitType INTEGER NJoints - - - "Number of joints of the sub structure" +typedef ^ SD_InitType INTEGER NPropSetsX - - - "Number of extended property sets" +typedef ^ SD_InitType INTEGER NPropSetsB - - - "Number of property sets for beams" +typedef ^ SD_InitType INTEGER NPropSetsC - - - "Number of property sets for cables" +typedef ^ SD_InitType INTEGER NPropSetsR - - - "Number of property sets for rigid links" +typedef ^ SD_InitType INTEGER NCMass - - - "Number of joints with concentrated mass" +typedef ^ SD_InitType INTEGER NCOSMs - - - "Number of independent cosine matrices" +typedef ^ SD_InitType INTEGER FEMMod - - - "FEM switch element model in the FEM" +typedef ^ SD_InitType INTEGER NDiv - - - "Number of divisions for each member" +typedef ^ SD_InitType LOGICAL CBMod - - - "Perform C-B flag" +typedef ^ SD_InitType ReKi Joints {:}{:} - - "Joints number and coordinate values" +typedef ^ SD_InitType ReKi PropSetsB {:}{:} - - "Property sets number and values" +typedef ^ SD_InitType ReKi PropSetsC {:}{:} - - "Property ID and values for cables" +typedef ^ SD_InitType ReKi PropSetsR {:}{:} - - "Property ID and values for rigid link" +typedef ^ SD_InitType ReKi PropSetsX {:}{:} - - "Extended property sets" +typedef ^ SD_InitType ReKi COSMs {:}{:} - - "Independent direction cosine matrices" +typedef ^ SD_InitType ReKi CMass {:}{:} - - "Concentrated mass information" +typedef ^ SD_InitType ReKi JDampings {:} - - "Damping coefficients for internal modes" +typedef ^ SD_InitType IntKi GuyanDampMod - - - "Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix]" +typedef ^ SD_InitType ReKi RayleighDamp {2} - - "Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1]" +typedef ^ SD_InitType ReKi GuyanDampMat {6}{6} - - "Guyan Damping Matrix, see also CBB" +typedef ^ SD_InitType INTEGER Members {:}{:} - - "Member joints connection " +typedef ^ SD_InitType CHARACTER(ChanLen) SSOutList {:} - - "List of Output Channels " +typedef ^ SD_InitType LOGICAL OutCOSM - - - "Output Cos-matrices Flag " +typedef ^ SD_InitType LOGICAL TabDelim - - - "Generate a tab-delimited output file in OutJckF-Flag " +typedef ^ SD_InitType R8Ki SSIK {:}{:} - - "SSI stiffness packed matrix elements (21 of them), for each reaction joint " +typedef ^ SD_InitType R8Ki SSIM {:}{:} - - "SSI mass packed matrix elements (21 of them), for each reaction joint " +typedef ^ SD_InitType CHARACTER(1024) SSIfile {:} - - "Soil Structure Interaction (SSI) files to associate with each reaction node" +typedef ^ SD_InitType ReKi Soil_K {:}{:}{:} - - "Soil stiffness (at passed at Init, not in input file) 6x6xn " +typedef ^ SD_InitType ReKi Soil_Points {:}{:} - - "Node positions where soil stiffness will be added " +typedef ^ SD_InitType Integer Soil_Nodes {:} - - "Node indices where soil stiffness will be added " +typedef ^ SD_InitType INTEGER NElem - - - "Total number of elements" +typedef ^ SD_InitType INTEGER NPropB - - - "Total number of property sets for Beams" +typedef ^ SD_InitType INTEGER NPropC - - - "Total number of property sets for Cable" +typedef ^ SD_InitType INTEGER NPropR - - - "Total number of property sets for Rigid" +typedef ^ SD_InitType ReKi Nodes {:}{:} - - "Nodes number and coordinates " +typedef ^ SD_InitType ReKi PropsB {:}{:} - - "Property sets and values for Beams " +typedef ^ SD_InitType ReKi PropsC {:}{:} - - "Property sets and values for Cable " +typedef ^ SD_InitType ReKi PropsR {:}{:} - - "Property sets and values for Rigid link" +typedef ^ SD_InitType R8Ki K {:}{:} - - "System stiffness matrix " +typedef ^ SD_InitType R8Ki M {:}{:} - - "System mass matrix " +typedef ^ SD_InitType ReKi ElemProps {:}{:} - - "Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) )" +typedef ^ SD_InitType INTEGER MemberNodes {:}{:} - - "Member number and list of nodes making up a member (>2 if subdivided)" +typedef ^ SD_InitType INTEGER NodesConnN {:}{:} - - "Nodes that connect to a common node " +typedef ^ SD_InitType INTEGER NodesConnE {:}{:} - - "Elements that connect to a common node" +typedef ^ SD_InitType LOGICAL SSSum - - - "SubDyn Summary File Flag " # ============================== States ============================================================================================================================================ -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType R8Ki qm {:} - - "Virtual states, Nmod elements" -typedef ^ ContinuousStateType R8Ki qmdot {:} - - "Derivative of states, Nmod elements" -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType ReKi DummyDiscState - - - "Remove this variable if you have discrete states" -# Define constraint states here: -typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" +typedef ^ ContinuousStateType R8Ki qm {:} - - "Virtual states, Nmod elements" +typedef ^ ContinuousStateType R8Ki qmdot {:} - - "Derivative of states, Nmod elements" + +typedef ^ DiscreteStateType ReKi DummyDiscState - - - "Remove this variable if you have discrete states" -# Define any other states, including integer or logical states here: -typedef SubDyn/SD OtherStateType SD_ContinuousStateType xdot {:} - - "previous state derivs for m-step time integrator" -typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated last" +typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" +typedef ^ OtherStateType SD_ContinuousStateType xdot {:} - - "previous state derivs for m-step time integrator" +typedef ^ ^ IntKi n - - - "tracks time step for which OtherState was updated last" # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): # e.g. indices for searching in an array, large arrays that are local variables in any routine called multiple times, etc. -typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" -typedef ^ ^ ReKi u_TP 6 - - -typedef ^ ^ ReKi udot_TP 6 - - -typedef ^ ^ ReKi udotdot_TP 6 - - -typedef ^ ^ ReKi UFL {:} - - -typedef ^ ^ ReKi UR_bar {:} - - -typedef ^ ^ ReKi UR_bar_dot {:} - - -typedef ^ ^ ReKi UR_bar_dotdot {:} - - -typedef ^ ^ ReKi UL {:} - - -typedef ^ ^ ReKi UL_dot {:} - - -typedef ^ ^ ReKi UL_dotdot {:} - - -typedef ^ ^ ReKi DU_full {:} - - "Delta U used for extra moment" -typedef ^ ^ ReKi U_full {:} - - -typedef ^ ^ ReKi U_full_dot {:} - - -typedef ^ ^ ReKi U_full_dotdot {:} - - -typedef ^ ^ ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating)" -typedef ^ ^ ReKi U_red {:} - - -typedef ^ ^ ReKi U_red_dot {:} - - -typedef ^ ^ ReKi U_red_dotdot {:} - - -typedef ^ ^ ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N +typedef ^ MiscVarType ReKi qmdotdot {:} - - "2nd Derivative of states, used only for output-file purposes" +typedef ^ MiscVarType ReKi u_TP 6 - - +typedef ^ MiscVarType ReKi udot_TP 6 - - +typedef ^ MiscVarType ReKi udotdot_TP 6 - - +typedef ^ MiscVarType ReKi F_L {:} - - +typedef ^ MiscVarType ReKi UR_bar {:} - - +typedef ^ MiscVarType ReKi UR_bar_dot {:} - - +typedef ^ MiscVarType ReKi UR_bar_dotdot {:} - - +typedef ^ MiscVarType ReKi UL {:} - - +typedef ^ MiscVarType ReKi UL_dot {:} - - +typedef ^ MiscVarType ReKi UL_dotdot {:} - - +typedef ^ MiscVarType ReKi DU_full {:} - - "Delta U used for extra moment" +typedef ^ MiscVarType ReKi U_full {:} - - +typedef ^ MiscVarType ReKi U_full_dot {:} - - +typedef ^ MiscVarType ReKi U_full_dotdot {:} - - +typedef ^ MiscVarType ReKi U_full_elast {:} - - "Elastic displacements for computation of K ue (without rigid body mode for floating)" +typedef ^ MiscVarType ReKi U_red {:} - - +typedef ^ MiscVarType ReKi U_red_dot {:} - - +typedef ^ MiscVarType ReKi U_red_dotdot {:} - - +typedef ^ MiscVarType ReKi FC_unit {:} - - "Cable Force vector (for varying cable load, of unit cable load)" N +typedef ^ MiscVarType ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" +typedef ^ MiscVarType DbKi LastOutTime - - - "The time of the most recent stored output data" "s" +typedef ^ MiscVarType IntKi Decimat - - - "Current output decimation counter" "-" +typedef ^ MiscVarType ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" +typedef ^ MiscVarType ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" ### data for writing to an output file (this data is associated with time, but saved/written in CalcOutput so not stored as an other state) ### -typedef ^ ^ ReKi SDWrOutput {:} - - "Data from previous step to be written to a SubDyn output file" -typedef ^ ^ DbKi LastOutTime - - - "The time of the most recent stored output data" "s" -typedef ^ ^ IntKi Decimat - - - "Current output decimation counter" "-" -typedef ^ ^ ReKi Fext {:} - - "External loads on unconstrained DOFs" "-" -typedef ^ ^ ReKi Fext_red {:} - - "External loads on constrained DOFs, Fext_red= T^t Fext" "-" - - # ============================== Parameters ============================================================================================================================================ -# --- Algo -typedef ^ ParameterType DbKi SDDeltaT - - - "Time step (for integration of continuous states)" seconds -typedef ^ ParameterType IntKi IntMethod - - - "INtegration Method (1/2/3)Length of y2 array" -# --- FEM -typedef ^ ParameterType INTEGER nDOF - - - "Total degree of freedom" -typedef ^ ParameterType INTEGER nDOF_red - - - "Total degree of freedom after constraint reduction" -typedef ^ ParameterType IntKi Nmembers - - - "Number of members of the sub structure" -typedef ^ ParameterType IntKi Elems {:}{:} - - "Element nodes connections" -typedef ^ ParameterType ElemPropType ElemProps {:} - - "List of element properties" -typedef ^ ^ R8Ki FG_full {:} - - "Gravity force vector (with initial cable force T0), not reduced" N -typedef ^ ^ ReKi DP0 {:}{:} - - "Vector from TP to a Node at t=0, used for Floating Rigid Body motion" m -# --- Constraints reduction -typedef ^ ^ Logical reduced - - - "True if system has been reduced to account for constraints" "-" -typedef ^ ^ R8Ki T_red {:}{:} - - "Transformation matrix performing the constraint reduction x = T. xtilde" "-" -typedef ^ ^ R8Ki T_red_T {:}{:} - - "Transpose of T_red" "-" -typedef ^ ^ IList NodesDOF {:} - - "DOF indices of each nodes in unconstrained assembled system " "-" -typedef ^ ^ IList NodesDOFred {:} - - "DOF indices of each nodes in constrained assembled system " "-" -typedef ^ ^ IntKi ElemsDOF {:}{:} - - "12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system " "-" -typedef ^ ^ IntKi DOFred2Nodes {:}{:} - - "nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1" "-" -# --- Control -typedef ^ ^ IntKi CtrlElem2Channel {:}{:} - - "nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index" -# --- CB reduction -typedef ^ ParameterType IntKi nDOFM - - - "retained degrees of freedom (modes)" -typedef ^ ParameterType IntKi SttcSolve - - - "Solve dynamics about static equilibrium point (flag)" -typedef ^ ParameterType Logical ExtraMoment - - - "Add Extra lever arm contribution to interface reaction outputs" -typedef ^ ParameterType Logical FixedBottom - - - "True if Fixed bottom (the 4 x-y DOF fixed for at least one reaction node)" -typedef ^ ParameterType Logical Floating - - - "True if floating bottom (the 6 DOF are free at all reaction nodes)" -typedef ^ ParameterType ReKi KMMDiag {:} - - "Diagonal coefficients of Kmm (OmegaM squared)" -typedef ^ ParameterType ReKi CMMDiag {:} - - "Diagonal coefficients of Cmm (~2 Zeta OmegaM))" -typedef ^ ParameterType ReKi MMB {:}{:} - - "Matrix after C-B reduction (transpose of MBM" -typedef ^ ParameterType ReKi FX {:} - - "Load components in X" -typedef ^ ParameterType ReKi C1_11 {:}{:} - - "Coefficient of x in Y1" -typedef ^ ParameterType ReKi C1_12 {:}{:} - - "Coefficient of x in Y1" -typedef ^ ParameterType ReKi D1_12 {:}{:} - - "Coefficient of uTPdot in Y1" -typedef ^ ParameterType ReKi D1_13 {:}{:} - - "Coefficient of uTPdotdot in Y1" -typedef ^ ParameterType ReKi D1_14 {:}{:} - - "Coefficient of Fle in Y1" -typedef ^ ParameterType ReKi FY {:} - - "Load Components in Y1" -typedef ^ ParameterType ReKi PhiM {:}{:} - - "Coefficient of x in Y2" -typedef ^ ParameterType ReKi C2_61 {:}{:} - - "Coefficient of x in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi C2_62 {:}{:} - - "Coefficient of x in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi PhiRb_TI {:}{:} - - "Coefficient of u in Y2 (Phi_R bar * TI)" -typedef ^ ParameterType ReKi D2_63 {:}{:} - - "Coefficient of u in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi D2_64 {:}{:} - - "Coefficient of u in Y2 (URdotdot ULdotdot)" -typedef ^ ParameterType ReKi F2_61 {:} - - "Load Component in Y2" -typedef ^ ParameterType ReKi MBB {:}{:} - - "Guyan Mass Matrix after C-B reduction" -typedef ^ ParameterType ReKi KBB {:}{:} - - "Guyan Stiffness Matrix after C-B reduction" -typedef ^ ParameterType ReKi CBB {:}{:} - - "Guyan Damping Matrix after C-B reduction" -typedef ^ ParameterType ReKi CMB {:}{:} - - "Cross coupling Guyan-CB damping matrix" -typedef ^ ParameterType ReKi CBM {:}{:} - - "Cross coupling Guyan-CB damping matrix" -typedef ^ ParameterType ReKi CMM {:}{:} - - "CB damping matrix" -typedef ^ ParameterType ReKi MBM {:}{:} - - "Matrix after C-B reduction" -typedef ^ ParameterType ReKi UL_st_g {:} - - "Motion of internal DOFs due to static gravitational force, for static improvement" -typedef ^ ParameterType ReKi PhiL_T {:}{:} - - "Transpose of Matrix of C-B modes" -typedef ^ ParameterType ReKi PhiLInvOmgL2 {:}{:} - - "Matrix of C-B modes times the inverse of OmegaL**2 (Phi_L*(Omg**2)^-1)" -typedef ^ ParameterType ReKi KLLm1 {:}{:} - - "KLL^{-1}, inverse of matrix KLL, for static solve only" -typedef ^ ParameterType ReKi AM2Jac {:}{:} - - "Jacobian (factored) for Adams-Boulton 2nd order Integration" -typedef ^ ParameterType IntKi AM2JacPiv {:} - - "Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration)" -typedef ^ ParameterType ReKi TI {:}{:} - - "Matrix to calculate TP reference point reaction at top of structure" -typedef ^ ParameterType ReKi TIreact {:}{:} - - "Matrix to calculate single point reaction at base of structure" -# --- Partitioning I L C Y, R=[C I] -typedef ^ ParameterType IntKi nNodes - - - "Total number of nodes" -typedef ^ ParameterType IntKi nNodes_I - - - "Number of Interface nodes" -typedef ^ ParameterType IntKi nNodes_L - - - "Number of Internal nodes" -typedef ^ ParameterType IntKi nNodes_C - - - "Number of joints with reactions" -typedef ^ ParameterType IntKi Nodes_I {:}{:} - - "Interface degree of freedoms" -typedef ^ ParameterType IntKi Nodes_L {:}{:} - - "Internal nodes (not interface nor reaction)" -typedef ^ ParameterType IntKi Nodes_C {:}{:} - - "React degree of freedoms" -typedef ^ ParameterType IntKi nDOFI__ - - - "Size of IDI__" -typedef ^ ParameterType IntKi nDOFI_Rb - - - "Size of IDI_Rb" -typedef ^ ParameterType IntKi nDOFI_F - - - "Size of IDI_F" -typedef ^ ParameterType IntKi nDOFL_L - - - "Size of IDL_L" -typedef ^ ParameterType IntKi nDOFC__ - - - "Size of IDC__" -typedef ^ ParameterType IntKi nDOFC_Rb - - - "Size of IDC_Rb" -typedef ^ ParameterType IntKi nDOFC_L - - - "Size of IDC_L" -typedef ^ ParameterType IntKi nDOFC_F - - - "Size of IDC_F" -typedef ^ ParameterType IntKi nDOFR__ - - - "Size of IDR__" -typedef ^ ParameterType IntKi nDOF__Rb - - - "Size of ID__Rb" -typedef ^ ParameterType IntKi nDOF__L - - - "Size of ID__L" -typedef ^ ParameterType IntKi nDOF__F - - - "Size of ID__F" -typedef ^ ParameterType IntKi IDI__ {:} - - "Index of all Interface DOFs" -typedef ^ ParameterType IntKi IDI_Rb {:} - - "Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs" -typedef ^ ParameterType IntKi IDI_F {:} - - "Index array of the interface (nodes connect to TP) dofs that are fixed DOF" -typedef ^ ParameterType IntKi IDL_L {:} - - "Index array of the internal dofs coming from internal nodes" -typedef ^ ParameterType IntKi IDC__ {:} - - "Index of all bottom DOF" -typedef ^ ParameterType IntKi IDC_Rb {:} - - "Index array of the contraint dofs that are retained/master/follower DOF" -typedef ^ ParameterType IntKi IDC_L {:} - - "Index array of the contraint dofs that are follower/internal DOF" -typedef ^ ParameterType IntKi IDC_F {:} - - "Index array of the contraint dofs that are fixd DOF" -typedef ^ ParameterType IntKi IDR__ {:} - - "Index array of the interface and restraint dofs" -typedef ^ ParameterType IntKi ID__Rb {:} - - "Index array of all the retained/leader/master dofs (from any nodes of the structure)" -typedef ^ ParameterType IntKi ID__L {:} - - "Index array of all the follower/internal dofs (from any nodes of the structure)" -typedef ^ ParameterType IntKi ID__F {:} - - "Index array of the DOF that are fixed (from any nodes of the structure)" -typedef ^ ParameterType ReKi FGL {:} - - "Internal node nDOFL, gravity loads" -# --- Outputs -typedef ^ ParameterType IntKi NMOutputs - - - "Number of members whose output is written" -typedef ^ ParameterType IntKi NumOuts - - - "Number of output channels read from input file" -typedef ^ ParameterType IntKi OutSwtch - - - "Output Requested Channels to local or global output file [1/2/3]" -typedef ^ ParameterType IntKi UnJckF - - - "Unit of SD ouput file" -typedef ^ ParameterType CHARACTER(1) Delim - - - "Column delimiter for output text files" -typedef ^ ParameterType CHARACTER(20) OutFmt - - - "Format for Output" -typedef ^ ParameterType CHARACTER(20) OutSFmt - - - "Format for Output Headers" -typedef ^ ParameterType MeshAuxDataType MoutLst {:} - - "List of user requested members and nodes" -typedef ^ ParameterType MeshAuxDataType MoutLst2 {:} - - "List of all member joint nodes and elements for output" -typedef ^ ParameterType MeshAuxDataType MoutLst3 {:} - - "List of all member joint nodes and elements for output" -typedef ^ ParameterType OutParmType OutParam {:} - - "An array holding names, units, and indices of all of the selected output channels. # logical" -typedef ^ ParameterType LOGICAL OutAll - - - "Flag to output or not all joint forces" -typedef ^ ParameterType LOGICAL OutReact - - - "Flag to check whether reactions are requested" -typedef ^ ParameterType IntKi OutAllInt - - - "Integer version of OutAll" -typedef ^ ParameterType IntKi OutAllDims - - - "Integer version of OutAll" -typedef ^ ParameterType IntKi OutDec - - - "Output Decimation for Requested Channels" -# --- Linearization -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType R8Ki dx {2} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - -typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - +# --- Parameters - Algo +typedef ^ ParameterType DbKi SDDeltaT - - - "Time step (for integration of continuous states)" seconds +typedef ^ ParameterType IntKi IntMethod - - - "Integration Method (1/2/3)Length of y2 array" +# --- Parameters - FEM +typedef ^ ParameterType INTEGER nDOF - - - "Total degree of freedom" +typedef ^ ParameterType INTEGER nDOF_red - - - "Total degree of freedom after constraint reduction" +typedef ^ ParameterType IntKi Nmembers - - - "Number of members of the sub structure" +typedef ^ ParameterType IntKi Elems {:}{:} - - "Element nodes connections" +typedef ^ ParameterType ElemPropType ElemProps {:} - - "List of element properties" +typedef ^ ParameterType R8Ki FG {:} - - "Gravity force vector (with initial cable force T0), not reduced" N +typedef ^ ParameterType ReKi DP0 {:}{:} - - "Vector from TP to a Node at t=0, used for Floating Rigid Body motion" m +# --- Parameters - Constraints reduction +typedef ^ ParameterType Logical reduced - - - "True if system has been reduced to account for constraints" "-" +typedef ^ ParameterType R8Ki T_red {:}{:} - - "Transformation matrix performing the constraint reduction x = T. xtilde" "-" +typedef ^ ParameterType R8Ki T_red_T {:}{:} - - "Transpose of T_red" "-" +typedef ^ ParameterType IList NodesDOF {:} - - "DOF indices of each nodes in unconstrained assembled system " "-" +typedef ^ ParameterType IList NodesDOFred {:} - - "DOF indices of each nodes in constrained assembled system " "-" +typedef ^ ParameterType IntKi ElemsDOF {:}{:} - - "12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system " "-" +typedef ^ ParameterType IntKi DOFred2Nodes {:}{:} - - "nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1" "-" +# --- Parameters - Control +typedef ^ ParameterType IntKi CtrlElem2Channel {:}{:} - - "nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index" +# --- Parameters - CB reduction +typedef ^ ParameterType IntKi nDOFM - - - "retained degrees of freedom (modes)" +typedef ^ ParameterType IntKi SttcSolve - - - "Solve dynamics about static equilibrium point (flag)" +typedef ^ ParameterType Logical ExtraMoment - - - "Add Extra lever arm contribution to interface reaction outputs" +typedef ^ ParameterType Logical Floating - - - "True if floating bottom (the 6 DOF are free at all reaction nodes)" +typedef ^ ParameterType ReKi KMMDiag {:} - - "Diagonal coefficients of Kmm (OmegaM squared)" +typedef ^ ParameterType ReKi CMMDiag {:} - - "Diagonal coefficients of Cmm (~2 Zeta OmegaM))" +typedef ^ ParameterType ReKi MMB {:}{:} - - "Matrix after C-B reduction (transpose of MBM" +typedef ^ ParameterType ReKi MBmmB {:}{:} - - "MBm * MmB, used for Y1" +typedef ^ ParameterType ReKi C1_11 {:}{:} - - "Coefficient of x in Y1" +typedef ^ ParameterType ReKi C1_12 {:}{:} - - "Coefficient of x in Y1" +typedef ^ ParameterType ReKi D1_141 {:}{:} - - "MBm PhiM^T" +typedef ^ ParameterType ReKi D1_142 {:}{:} - - "TI^T PhiR^T" +typedef ^ ParameterType ReKi PhiM {:}{:} - - "Coefficient of x in Y2" +typedef ^ ParameterType ReKi C2_61 {:}{:} - - "Coefficient of x in Y2 (URdotdot ULdotdot)" +typedef ^ ParameterType ReKi C2_62 {:}{:} - - "Coefficient of x in Y2 (URdotdot ULdotdot)" +typedef ^ ParameterType ReKi PhiRb_TI {:}{:} - - "Coefficient of u in Y2 (Phi_R bar * TI)" +typedef ^ ParameterType ReKi D2_63 {:}{:} - - "Coefficient of u in Y2 (URdotdot ULdotdot)" +typedef ^ ParameterType ReKi D2_64 {:}{:} - - "Coefficient of u in Y2 (URdotdot ULdotdot)" +typedef ^ ParameterType ReKi MBB {:}{:} - - "Guyan Mass Matrix after C-B reduction" +typedef ^ ParameterType ReKi KBB {:}{:} - - "Guyan Stiffness Matrix after C-B reduction" +typedef ^ ParameterType ReKi CBB {:}{:} - - "Guyan Damping Matrix after C-B reduction" +typedef ^ ParameterType ReKi CMM {:}{:} - - "CB damping matrix" +typedef ^ ParameterType ReKi MBM {:}{:} - - "Matrix after C-B reduction" +typedef ^ ParameterType ReKi PhiL_T {:}{:} - - "Transpose of Matrix of C-B modes" +typedef ^ ParameterType ReKi PhiLInvOmgL2 {:}{:} - - "Matrix of C-B modes times the inverse of OmegaL**2 (Phi_L*(Omg**2)^-1)" +typedef ^ ParameterType ReKi KLLm1 {:}{:} - - "KLL^{-1}, inverse of matrix KLL, for static solve only" +typedef ^ ParameterType ReKi AM2Jac {:}{:} - - "Jacobian (factored) for Adams-Boulton 2nd order Integration" +typedef ^ ParameterType IntKi AM2JacPiv {:} - - "Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration)" +typedef ^ ParameterType ReKi TI {:}{:} - - "Matrix to calculate TP reference point reaction at top of structure" +typedef ^ ParameterType ReKi TIreact {:}{:} - - "Matrix to calculate single point reaction at base of structure" +# --- Parameters - Partitioning I L C Y, R=[C I] +typedef ^ ParameterType IntKi nNodes - - - "Total number of nodes" +typedef ^ ParameterType IntKi nNodes_I - - - "Number of Interface nodes" +typedef ^ ParameterType IntKi nNodes_L - - - "Number of Internal nodes" +typedef ^ ParameterType IntKi nNodes_C - - - "Number of joints with reactions" +typedef ^ ParameterType IntKi Nodes_I {:}{:} - - "Interface degree of freedoms" +typedef ^ ParameterType IntKi Nodes_L {:}{:} - - "Internal nodes (not interface nor reaction)" +typedef ^ ParameterType IntKi Nodes_C {:}{:} - - "React degree of freedoms" +typedef ^ ParameterType IntKi nDOFI__ - - - "Size of IDI__" +typedef ^ ParameterType IntKi nDOFI_Rb - - - "Size of IDI_Rb" +typedef ^ ParameterType IntKi nDOFI_F - - - "Size of IDI_F" +typedef ^ ParameterType IntKi nDOFL_L - - - "Size of IDL_L" +typedef ^ ParameterType IntKi nDOFC__ - - - "Size of IDC__" +typedef ^ ParameterType IntKi nDOFC_Rb - - - "Size of IDC_Rb" +typedef ^ ParameterType IntKi nDOFC_L - - - "Size of IDC_L" +typedef ^ ParameterType IntKi nDOFC_F - - - "Size of IDC_F" +typedef ^ ParameterType IntKi nDOFR__ - - - "Size of IDR__" +typedef ^ ParameterType IntKi nDOF__Rb - - - "Size of ID__Rb" +typedef ^ ParameterType IntKi nDOF__L - - - "Size of ID__L" +typedef ^ ParameterType IntKi nDOF__F - - - "Size of ID__F" +typedef ^ ParameterType IntKi IDI__ {:} - - "Index of all Interface DOFs" +typedef ^ ParameterType IntKi IDI_Rb {:} - - "Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs" +typedef ^ ParameterType IntKi IDI_F {:} - - "Index array of the interface (nodes connect to TP) dofs that are fixed DOF" +typedef ^ ParameterType IntKi IDL_L {:} - - "Index array of the internal dofs coming from internal nodes" +typedef ^ ParameterType IntKi IDC__ {:} - - "Index of all bottom DOF" +typedef ^ ParameterType IntKi IDC_Rb {:} - - "Index array of the contraint dofs that are retained/master/follower DOF" +typedef ^ ParameterType IntKi IDC_L {:} - - "Index array of the contraint dofs that are follower/internal DOF" +typedef ^ ParameterType IntKi IDC_F {:} - - "Index array of the contraint dofs that are fixd DOF" +typedef ^ ParameterType IntKi IDR__ {:} - - "Index array of the interface and restraint dofs" +typedef ^ ParameterType IntKi ID__Rb {:} - - "Index array of all the retained/leader/master dofs (from any nodes of the structure)" +typedef ^ ParameterType IntKi ID__L {:} - - "Index array of all the follower/internal dofs (from any nodes of the structure)" +typedef ^ ParameterType IntKi ID__F {:} - - "Index array of the DOF that are fixed (from any nodes of the structure)" +# --- Parameters - Outputs +typedef ^ ParameterType IntKi NMOutputs - - - "Number of members whose output is written" +typedef ^ ParameterType IntKi NumOuts - - - "Number of output channels read from input file" +typedef ^ ParameterType IntKi OutSwtch - - - "Output Requested Channels to local or global output file [1/2/3]" +typedef ^ ParameterType IntKi UnJckF - - - "Unit of SD ouput file" +typedef ^ ParameterType CHARACTER(1) Delim - - - "Column delimiter for output text files" +typedef ^ ParameterType CHARACTER(20) OutFmt - - - "Format for Output" +typedef ^ ParameterType CHARACTER(20) OutSFmt - - - "Format for Output Headers" +typedef ^ ParameterType MeshAuxDataType MoutLst {:} - - "List of user requested members and nodes" +typedef ^ ParameterType MeshAuxDataType MoutLst2 {:} - - "List of all member joint nodes and elements for output" +typedef ^ ParameterType MeshAuxDataType MoutLst3 {:} - - "List of all member joint nodes and elements for output" +typedef ^ ParameterType OutParmType OutParam {:} - - "An array holding names, units, and indices of all of the selected output channels. # logical" +typedef ^ ParameterType LOGICAL OutAll - - - "Flag to output or not all joint forces" +typedef ^ ParameterType LOGICAL OutReact - - - "Flag to check whether reactions are requested" +typedef ^ ParameterType IntKi OutAllInt - - - "Integer version of OutAll" +typedef ^ ParameterType IntKi OutAllDims - - - "Integer version of OutAll" +typedef ^ ParameterType IntKi OutDec - - - "Output Decimation for Requested Channels" +# --- Parametesr - Linearization +typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" +typedef ^ ParameterType R8Ki dx {2} - - "vector that determines size of perturbation for x (continuous states)" +typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ ParameterType Integer Jac_nx - - - "half the number of continuous states in jacobian matrix" - +typedef ^ ParameterType logical RotStates - - - "Orient states in rotating frame during linearization? (flag)" - # ============================== Inputs ============================================================================================================================================ -typedef ^ InputType MeshType TPMesh - - - "Transition piece inputs on a point mesh" -typedef ^ InputType MeshType LMesh - - - "Point mesh for interior node inputs" -typedef ^ InputType ReKi CableDeltaL {:} - - "Cable tension, control input" +typedef ^ InputType MeshType TPMesh - - - "Transition piece inputs on a point mesh" +typedef ^ InputType MeshType LMesh - - - "Point mesh for interior node inputs" +typedef ^ InputType ReKi CableDeltaL {:} - - "Cable tension, control input" # ============================== Outputs ============================================================================================================================================ -typedef ^ OutputType MeshType Y1Mesh - - - "Transition piece outputs on a point mesh" -typedef ^ OutputType MeshType Y2Mesh - - - "Interior+Interface nodes outputs on a point mesh" -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file" +typedef ^ OutputType MeshType Y1Mesh - - - "Transition piece outputs on a point mesh" +typedef ^ OutputType MeshType Y2Mesh - - - "Interior+Interface nodes outputs on a point mesh" +typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file" diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 7b6c13e932..a7162c816b 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -38,34 +38,6 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: List !< List of integers [-] END TYPE IList ! ======================= -! ========= 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) , 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. [-] - END TYPE SD_InitInputType -! ======================= -! ========= SD_InitOutputType ======= - TYPE, PUBLIC :: SD_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 [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - 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 [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue) [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] - LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] - END TYPE SD_InitOutputType -! ======================= ! ========= MeshAuxDataType ======= TYPE, PUBLIC :: MeshAuxDataType INTEGER(IntKi) :: MemberID !< Member ID for Output [-] @@ -106,6 +78,34 @@ MODULE SubDyn_Types REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos !< 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) , 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. [-] + END TYPE SD_InitInputType +! ======================= +! ========= SD_InitOutputType ======= + TYPE, PUBLIC :: SD_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 [-] + TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + 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 [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue) [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] + END TYPE SD_InitOutputType +! ======================= ! ========= SD_InitType ======= TYPE, PUBLIC :: SD_InitType CHARACTER(1024) :: RootName !< SubDyn rootname [-] @@ -134,32 +134,31 @@ MODULE SubDyn_Types 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) , 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 [-] - 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 [-] + 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 [-] + 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 [-] + 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 [-] - 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 [-] + 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 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsR !< Property sets and values for Rigid link [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: K !< System stiffness matrix [-] - REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: M !< System mass matrix [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (include initial Cable force T0) [N] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: K !< System stiffness matrix [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: M !< System mass matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ElemProps !< Element properties(A, L, Ixx, Iyy, Jzz, Shear, Kappa, E, G, Rho, DirCos(1,1), DirCos(2, 1), ....., DirCos(3, 3) ) [-] 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 :: 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 !< SubDyn Summary File Flag [-] END TYPE SD_InitType ! ======================= ! ========= SD_ContinuousStateType ======= @@ -190,7 +189,7 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(1:6) :: u_TP REAL(ReKi) , DIMENSION(1:6) :: udot_TP REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UFL + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dot REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar_dotdot @@ -216,13 +215,13 @@ 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) :: 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 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG_full !< Gravity force vector (with initial cable force T0), not reduced [N] + 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] LOGICAL :: reduced !< 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 [-] @@ -235,33 +234,26 @@ MODULE SubDyn_Types INTEGER(IntKi) :: nDOFM !< retained degrees of freedom (modes) [-] INTEGER(IntKi) :: SttcSolve !< Solve dynamics about static equilibrium point (flag) [-] LOGICAL :: ExtraMoment !< Add Extra lever arm contribution to interface reaction outputs [-] - LOGICAL :: FixedBottom !< True if Fixed bottom (the 4 x-y DOF fixed for at least one reaction node) [-] LOGICAL :: Floating !< 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 [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FX !< Load components in X [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBmmB !< MBm * MmB, used for Y1 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_11 !< Coefficient of x in Y1 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C1_12 !< Coefficient of x in Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_12 !< Coefficient of uTPdot in Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_13 !< Coefficient of uTPdotdot in Y1 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_14 !< Coefficient of Fle in Y1 [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FY !< Load Components in Y1 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_141 !< MBm PhiM^T [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D1_142 !< TI^T PhiR^T [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiM !< Coefficient of x in Y2 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_61 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C2_62 !< Coefficient of x in Y2 (URdotdot ULdotdot) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiRb_TI !< Coefficient of u in Y2 (Phi_R bar * TI) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_63 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: D2_64 !< Coefficient of u in Y2 (URdotdot ULdotdot) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F2_61 !< Load Component in Y2 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBB !< Guyan Mass Matrix after C-B reduction [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KBB !< Guyan Stiffness Matrix after C-B reduction [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CBB !< Guyan Damping Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMB !< Cross coupling Guyan-CB damping matrix [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CBM !< Cross coupling Guyan-CB damping matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMM !< CB damping matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MBM !< Matrix after C-B reduction [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_st_g !< Motion of internal DOFs due to static gravitational force, for static improvement [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiL_T !< Transpose of Matrix of C-B modes [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PhiLInvOmgL2 !< Matrix of C-B modes times the inverse of OmegaL**2 (Phi_L*(Omg**2)^-1) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: KLLm1 !< KLL^{-1}, inverse of matrix KLL, for static solve only [-] @@ -300,7 +292,6 @@ 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) [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FGL !< Internal node nDOFL, gravity loads [-] 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] [-] @@ -520,9 +511,9 @@ SUBROUTINE SD_UnPackIList( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END IF END SUBROUTINE SD_UnPackIList - SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(SD_InitInputType), INTENT(INOUT) :: DstInitInputData + 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 @@ -531,60 +522,158 @@ SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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_CopyInitInput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMeshAuxDataType' ! 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) + 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 DstInitInputData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness + DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt 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 +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_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData + SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) + TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(InitInputData%SoilStiffness)) THEN - DEALLOCATE(InitInputData%SoilStiffness) +IF (ALLOCATED(MeshAuxDataTypeData%NodeCnt)) THEN + DEALLOCATE(MeshAuxDataTypeData%NodeCnt) ENDIF - CALL MeshDestroy( InitInputData%SoilMesh, ErrStat, ErrMsg ) - END SUBROUTINE SD_DestroyInitInput +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_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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(SD_InitInputType), INTENT(IN) :: InData + TYPE(MeshAuxDataType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -599,7 +688,7 @@ SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitInput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMeshAuxDataType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -615,36 +704,43 @@ SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 + 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 - ! 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 @@ -672,86 +768,172 @@ SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg 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) = 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%SoilStiffness,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeCnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,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 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) + + 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 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 + 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 - 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 ( .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 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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)) + 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 - END SUBROUTINE SD_PackInitInput + 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 - SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + 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(SD_InitInputType), INTENT(INOUT) :: OutData + TYPE(MeshAuxDataType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -763,9 +945,10 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitInput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMeshAuxDataType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -776,27 +959,93 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err 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 + 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 @@ -809,252 +1058,223 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err 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) + 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%SoilStiffness.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', 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 + 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 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitInput + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( 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_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SD_InitOutputType), INTENT(INOUT) :: DstInitOutputData + 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_CopyInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyCB_MatArrays' ! 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 (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 DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB 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 (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 DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM 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 (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 DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB 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 (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 DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL 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 (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 DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR 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 (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 DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL ENDIF - END SUBROUTINE SD_CopyInitOutput + END SUBROUTINE SD_CopyCB_MatArrays - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData + 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_DestroyInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! 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, ErrStat, ErrMsg ) -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) +IF (ALLOCATED(CB_MatArraysData%MBB)) THEN + DEALLOCATE(CB_MatArraysData%MBB) ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) +IF (ALLOCATED(CB_MatArraysData%MBM)) THEN + DEALLOCATE(CB_MatArraysData%MBM) ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) +IF (ALLOCATED(CB_MatArraysData%KBB)) THEN + DEALLOCATE(CB_MatArraysData%KBB) ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) +IF (ALLOCATED(CB_MatArraysData%PhiL)) THEN + DEALLOCATE(CB_MatArraysData%PhiL) ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) +IF (ALLOCATED(CB_MatArraysData%PhiR)) THEN + DEALLOCATE(CB_MatArraysData%PhiR) ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) +IF (ALLOCATED(CB_MatArraysData%OmegaL)) THEN + DEALLOCATE(CB_MatArraysData%OmegaL) ENDIF - END SUBROUTINE SD_DestroyInitOutput + END SUBROUTINE SD_DestroyCB_MatArrays - SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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(SD_InitOutputType), INTENT(IN) :: InData + TYPE(CB_MatArrays), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -1069,7 +1289,7 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackCB_MatArrays' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1085,80 +1305,42 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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 + 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 - ! 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 + 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 ! 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 + 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 ! 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 + 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 ! 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 + 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 ! 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 + 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 - 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 + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF IF ( Db_BufSz .GT. 0 ) THEN ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) @@ -1180,201 +1362,128 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + 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%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) 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 + 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 - 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 + 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%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) 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 + 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%LinNames_u) ) THEN + 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%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) 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 + 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%RotFrame_x) ) THEN + 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%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) 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 + 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%IsLoad_u) ) THEN + 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%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,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 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 + 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%DerivOrder_x) ) THEN + 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%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,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%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 + 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_PackInitOutput + END SUBROUTINE SD_PackCB_MatArrays - SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + 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(SD_InitOutputType), INTENT(INOUT) :: OutData + TYPE(CB_MatArrays), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -1384,9 +1493,10 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er 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_UnPackInitOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackCB_MatArrays' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1397,241 +1507,144 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + 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 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + 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%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', 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 + 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 ! WriteOutputUnt not allocated + 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 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + 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%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', 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 + 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 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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 + 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 - 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) + i2_l = IntKiBuf( Int_Xferred ) + i2_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 (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%LinNames_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', 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 + 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 ! RotFrame_y not allocated + 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 - 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) + i2_l = IntKiBuf( Int_Xferred ) + i2_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 (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%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', 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 + 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 ! RotFrame_u not allocated + 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 - 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) + i2_l = IntKiBuf( Int_Xferred ) + i2_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 (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%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', 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 + 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 ! DerivOrder_x not allocated + 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%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + 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%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', 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 + 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_UnPackInitOutput + END SUBROUTINE SD_UnPackCB_MatArrays - SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(IN) :: SrcMeshAuxDataTypeData - TYPE(MeshAuxDataType), INTENT(INOUT) :: DstMeshAuxDataTypeData + 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 @@ -1639,159 +1652,43 @@ SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeDat 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' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyElemPropType' ! 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 + 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 = SrcElemPropTypeData%Kappa + DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE + DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG + DstElemPropTypeData%Area = SrcElemPropTypeData%Area + DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho + DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 + DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos + END SUBROUTINE SD_CopyElemPropType - SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData + SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg ) + TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! 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 + END SUBROUTINE SD_DestroyElemPropType - SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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(MeshAuxDataType), INTENT(IN) :: InData + TYPE(ElemPropType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -1806,7 +1703,7 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMeshAuxDataType' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackElemPropType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1822,43 +1719,19 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 + 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 + Re_BufSz = Re_BufSz + 1 ! YoungE + Re_BufSz = Re_BufSz + 1 ! ShearG + 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 @@ -1886,317 +1759,379 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, 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 + IntKiBuf(Int_Xferred) = InData%eType Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( 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 - 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 + ReKiBuf(Re_Xferred) = InData%Kappa + 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 + 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 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 + END DO + END SUBROUTINE SD_PackElemPropType - 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 + 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 - ELSE - IntKiBuf( 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 - 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 + OutData%Kappa = 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 + 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 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 + END DO + END SUBROUTINE SD_UnPackElemPropType - 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 + 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 - END SUBROUTINE SD_PackMeshAuxDataType + 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_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 + SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InitInputData%SoilStiffness)) THEN + DEALLOCATE(InitInputData%SoilStiffness) +ENDIF + CALL MeshDestroy( InitInputData%SoilMesh, ErrStat, ErrMsg ) + 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) :: Buf_size + INTEGER(IntKi) :: Re_BufSz INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz 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) :: i,i1,i2,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_UnPackMeshAuxDataType' - ! buffers to store meshes, if any + 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_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 + 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 - 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) + ! 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 - 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 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) + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', 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 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) + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', 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 END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated + 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 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,2) Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) 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 + + 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated + 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 @@ -2209,190 +2144,252 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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 (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%Ke.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', 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 + 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL 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 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_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) + 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 OutData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', 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) + 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 DstCB_MatArraysData%MBB.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x 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 (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 DstCB_MatArraysData%MBM.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u 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 (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 DstCB_MatArraysData%KBB.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y 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 (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 DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x 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 (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 DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u 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 (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 DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u ENDIF - END SUBROUTINE SD_CopyCB_MatArrays +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 SD_CopyInitOutput - SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData + SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(CB_MatArraysData%MBB)) THEN - DEALLOCATE(CB_MatArraysData%MBB) +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) ENDIF -IF (ALLOCATED(CB_MatArraysData%MBM)) THEN - DEALLOCATE(CB_MatArraysData%MBM) +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) ENDIF -IF (ALLOCATED(CB_MatArraysData%KBB)) THEN - DEALLOCATE(CB_MatArraysData%KBB) + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) +IF (ALLOCATED(InitOutputData%LinNames_y)) THEN + DEALLOCATE(InitOutputData%LinNames_y) ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiL)) THEN - DEALLOCATE(CB_MatArraysData%PhiL) +IF (ALLOCATED(InitOutputData%LinNames_x)) THEN + DEALLOCATE(InitOutputData%LinNames_x) ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiR)) THEN - DEALLOCATE(CB_MatArraysData%PhiR) +IF (ALLOCATED(InitOutputData%LinNames_u)) THEN + DEALLOCATE(InitOutputData%LinNames_u) ENDIF -IF (ALLOCATED(CB_MatArraysData%OmegaL)) THEN - DEALLOCATE(CB_MatArraysData%OmegaL) +IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN + DEALLOCATE(InitOutputData%RotFrame_y) ENDIF - END SUBROUTINE SD_DestroyCB_MatArrays +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 SD_DestroyInitOutput - SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + 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(CB_MatArrays), INTENT(IN) :: InData + TYPE(SD_InitOutputType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -2407,7 +2404,7 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackCB_MatArrays' + CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitOutput' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -2423,35 +2420,73 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err 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 + 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 ! 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 + 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 ! 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 + ! 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 ! 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 + 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 ! 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 + 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 ! 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 + 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 ) @@ -2480,498 +2515,454 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%MBB) ) THEN + 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%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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) 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 + 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%MBM) ) THEN + 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%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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) 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 + 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%KBB) ) THEN + 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%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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) 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 + 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%PhiL) ) THEN + 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%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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) 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 + 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%PhiR) ) THEN + 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%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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) 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 + 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%OmegaL) ) THEN + 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%OmegaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,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%OmegaL,1), UBOUND(InData%OmegaL,1) - DbKiBuf(Db_Xferred) = InData%OmegaL(i1) - Db_Xferred = Db_Xferred + 1 + 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 - 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 + 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 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( 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 - 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 + + 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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated + 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 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( 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 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + + 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 - 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 + + 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 ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated + 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 - 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 (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%KBB.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', 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 + 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 ! PhiL not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiL)) DEALLOCATE(OutData%PhiL) - ALLOCATE(OutData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', 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 + 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 ! PhiR not allocated + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + 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 - 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 (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%PhiR.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', 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 + 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 ! OmegaL not allocated + 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%OmegaL)) DEALLOCATE(OutData%OmegaL) - ALLOCATE(OutData%OmegaL(i1_l:i1_u),STAT=ErrStat2) + 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%OmegaL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', 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 = SrcElemPropTypeData%Kappa - DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE - DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG - 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 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - 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 - Re_BufSz = Re_BufSz + 1 ! YoungE - Re_BufSz = Re_BufSz + 1 ! ShearG - 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) + 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 + 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 ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + 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 + 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 ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + 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 + 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(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 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated 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)) + ELSE Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa - 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 - 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 + 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 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) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated 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) + ELSE Int_Xferred = Int_Xferred + 1 - OutData%Kappa = 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 - 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 + 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 DO - END SUBROUTINE SD_UnPackElemPropType + 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 SD_UnPackInitOutput SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_InitType), INTENT(IN) :: SrcInitTypeData @@ -3316,18 +3307,6 @@ SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, END IF DstInitTypeData%M = SrcInitTypeData%M ENDIF -IF (ALLOCATED(SrcInitTypeData%FG)) THEN - i1_l = LBOUND(SrcInitTypeData%FG,1) - i1_u = UBOUND(SrcInitTypeData%FG,1) - IF (.NOT. ALLOCATED(DstInitTypeData%FG)) THEN - ALLOCATE(DstInitTypeData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%FG = SrcInitTypeData%FG -ENDIF IF (ALLOCATED(SrcInitTypeData%ElemProps)) THEN i1_l = LBOUND(SrcInitTypeData%ElemProps,1) i1_u = UBOUND(SrcInitTypeData%ElemProps,1) @@ -3462,9 +3441,6 @@ SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(InitTypeData%M)) THEN DEALLOCATE(InitTypeData%M) ENDIF -IF (ALLOCATED(InitTypeData%FG)) THEN - DEALLOCATE(InitTypeData%FG) -ENDIF IF (ALLOCATED(InitTypeData%ElemProps)) THEN DEALLOCATE(InitTypeData%ElemProps) ENDIF @@ -3648,11 +3624,6 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 ! 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 ! ElemProps allocated yes/no IF ( ALLOCATED(InData%ElemProps) ) THEN Int_BufSz = Int_BufSz + 2*2 ! ElemProps upper/lower bounds for each dimension @@ -4188,21 +4159,6 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, 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 - - 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%ElemProps) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4870,29 +4826,11 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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 ! 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 + 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 @@ -5768,17 +5706,17 @@ SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%u_TP = SrcMiscData%u_TP DstMiscData%udot_TP = SrcMiscData%udot_TP DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP -IF (ALLOCATED(SrcMiscData%UFL)) THEN - i1_l = LBOUND(SrcMiscData%UFL,1) - i1_u = UBOUND(SrcMiscData%UFL,1) - IF (.NOT. ALLOCATED(DstMiscData%UFL)) THEN - ALLOCATE(DstMiscData%UFL(i1_l:i1_u),STAT=ErrStat2) +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%UFL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%UFL = SrcMiscData%UFL + DstMiscData%F_L = SrcMiscData%F_L ENDIF IF (ALLOCATED(SrcMiscData%UR_bar)) THEN i1_l = LBOUND(SrcMiscData%UR_bar,1) @@ -6012,8 +5950,8 @@ SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%qmdotdot)) THEN DEALLOCATE(MiscData%qmdotdot) ENDIF -IF (ALLOCATED(MiscData%UFL)) THEN - DEALLOCATE(MiscData%UFL) +IF (ALLOCATED(MiscData%F_L)) THEN + DEALLOCATE(MiscData%F_L) ENDIF IF (ALLOCATED(MiscData%UR_bar)) THEN DEALLOCATE(MiscData%UR_bar) @@ -6114,10 +6052,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz 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 ! UFL allocated yes/no - IF ( ALLOCATED(InData%UFL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UFL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UFL) ! UFL + 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 ! UR_bar allocated yes/no IF ( ALLOCATED(InData%UR_bar) ) THEN @@ -6265,18 +6203,18 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) Re_Xferred = Re_Xferred + 1 END DO - IF ( .NOT. ALLOCATED(InData%UFL) ) THEN + 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%UFL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UFL,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%UFL,1), UBOUND(InData%UFL,1) - ReKiBuf(Re_Xferred) = InData%UFL(i1) + 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 @@ -6619,21 +6557,21 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UFL not allocated + 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%UFL)) DEALLOCATE(OutData%UFL) - ALLOCATE(OutData%UFL(i1_l:i1_u),STAT=ErrStat2) + 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%UFL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%UFL,1), UBOUND(OutData%UFL,1) - OutData%UFL(i1) = ReKiBuf(Re_Xferred) + 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 @@ -7018,17 +6956,17 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcParamData%FG_full)) THEN - i1_l = LBOUND(SrcParamData%FG_full,1) - i1_u = UBOUND(SrcParamData%FG_full,1) - IF (.NOT. ALLOCATED(DstParamData%FG_full)) THEN - ALLOCATE(DstParamData%FG_full(i1_l:i1_u),STAT=ErrStat2) +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_full.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%FG_full = SrcParamData%FG_full + DstParamData%FG = SrcParamData%FG ENDIF IF (ALLOCATED(SrcParamData%DP0)) THEN i1_l = LBOUND(SrcParamData%DP0,1) @@ -7150,7 +7088,6 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%nDOFM = SrcParamData%nDOFM DstParamData%SttcSolve = SrcParamData%SttcSolve DstParamData%ExtraMoment = SrcParamData%ExtraMoment - DstParamData%FixedBottom = SrcParamData%FixedBottom DstParamData%Floating = SrcParamData%Floating IF (ALLOCATED(SrcParamData%KMMDiag)) THEN i1_l = LBOUND(SrcParamData%KMMDiag,1) @@ -7190,17 +7127,19 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%MMB = SrcParamData%MMB 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 (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%FX.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%FX = SrcParamData%FX + DstParamData%MBmmB = SrcParamData%MBmmB ENDIF IF (ALLOCATED(SrcParamData%C1_11)) THEN i1_l = LBOUND(SrcParamData%C1_11,1) @@ -7230,59 +7169,33 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%C1_12 = SrcParamData%C1_12 ENDIF -IF (ALLOCATED(SrcParamData%D1_12)) THEN - i1_l = LBOUND(SrcParamData%D1_12,1) - i1_u = UBOUND(SrcParamData%D1_12,1) - i2_l = LBOUND(SrcParamData%D1_12,2) - i2_u = UBOUND(SrcParamData%D1_12,2) - IF (.NOT. ALLOCATED(DstParamData%D1_12)) THEN - ALLOCATE(DstParamData%D1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_12 = SrcParamData%D1_12 -ENDIF -IF (ALLOCATED(SrcParamData%D1_13)) THEN - i1_l = LBOUND(SrcParamData%D1_13,1) - i1_u = UBOUND(SrcParamData%D1_13,1) - i2_l = LBOUND(SrcParamData%D1_13,2) - i2_u = UBOUND(SrcParamData%D1_13,2) - IF (.NOT. ALLOCATED(DstParamData%D1_13)) THEN - ALLOCATE(DstParamData%D1_13(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_13.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_13 = SrcParamData%D1_13 -ENDIF -IF (ALLOCATED(SrcParamData%D1_14)) THEN - i1_l = LBOUND(SrcParamData%D1_14,1) - i1_u = UBOUND(SrcParamData%D1_14,1) - i2_l = LBOUND(SrcParamData%D1_14,2) - i2_u = UBOUND(SrcParamData%D1_14,2) - IF (.NOT. ALLOCATED(DstParamData%D1_14)) THEN - ALLOCATE(DstParamData%D1_14(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +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_14.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%D1_14 = SrcParamData%D1_14 + DstParamData%D1_141 = SrcParamData%D1_141 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 (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%FY.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%FY = SrcParamData%FY + DstParamData%D1_142 = SrcParamData%D1_142 ENDIF IF (ALLOCATED(SrcParamData%PhiM)) THEN i1_l = LBOUND(SrcParamData%PhiM,1) @@ -7368,18 +7281,6 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%D2_64 = SrcParamData%D2_64 ENDIF -IF (ALLOCATED(SrcParamData%F2_61)) THEN - i1_l = LBOUND(SrcParamData%F2_61,1) - i1_u = UBOUND(SrcParamData%F2_61,1) - IF (.NOT. ALLOCATED(DstParamData%F2_61)) THEN - ALLOCATE(DstParamData%F2_61(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F2_61 = SrcParamData%F2_61 -ENDIF IF (ALLOCATED(SrcParamData%MBB)) THEN i1_l = LBOUND(SrcParamData%MBB,1) i1_u = UBOUND(SrcParamData%MBB,1) @@ -7422,34 +7323,6 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%CBB = SrcParamData%CBB ENDIF -IF (ALLOCATED(SrcParamData%CMB)) THEN - i1_l = LBOUND(SrcParamData%CMB,1) - i1_u = UBOUND(SrcParamData%CMB,1) - i2_l = LBOUND(SrcParamData%CMB,2) - i2_u = UBOUND(SrcParamData%CMB,2) - IF (.NOT. ALLOCATED(DstParamData%CMB)) THEN - ALLOCATE(DstParamData%CMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMB = SrcParamData%CMB -ENDIF -IF (ALLOCATED(SrcParamData%CBM)) THEN - i1_l = LBOUND(SrcParamData%CBM,1) - i1_u = UBOUND(SrcParamData%CBM,1) - i2_l = LBOUND(SrcParamData%CBM,2) - i2_u = UBOUND(SrcParamData%CBM,2) - IF (.NOT. ALLOCATED(DstParamData%CBM)) THEN - ALLOCATE(DstParamData%CBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBM = SrcParamData%CBM -ENDIF IF (ALLOCATED(SrcParamData%CMM)) THEN i1_l = LBOUND(SrcParamData%CMM,1) i1_u = UBOUND(SrcParamData%CMM,1) @@ -7478,18 +7351,6 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%MBM = SrcParamData%MBM ENDIF -IF (ALLOCATED(SrcParamData%UL_st_g)) THEN - i1_l = LBOUND(SrcParamData%UL_st_g,1) - i1_u = UBOUND(SrcParamData%UL_st_g,1) - IF (.NOT. ALLOCATED(DstParamData%UL_st_g)) THEN - ALLOCATE(DstParamData%UL_st_g(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%UL_st_g.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%UL_st_g = SrcParamData%UL_st_g -ENDIF IF (ALLOCATED(SrcParamData%PhiL_T)) THEN i1_l = LBOUND(SrcParamData%PhiL_T,1) i1_u = UBOUND(SrcParamData%PhiL_T,1) @@ -7787,18 +7648,6 @@ SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF END IF DstParamData%ID__F = SrcParamData%ID__F -ENDIF -IF (ALLOCATED(SrcParamData%FGL)) THEN - i1_l = LBOUND(SrcParamData%FGL,1) - i1_u = UBOUND(SrcParamData%FGL,1) - IF (.NOT. ALLOCATED(DstParamData%FGL)) THEN - ALLOCATE(DstParamData%FGL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FGL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FGL = SrcParamData%FGL ENDIF DstParamData%NMOutputs = SrcParamData%NMOutputs DstParamData%NumOuts = SrcParamData%NumOuts @@ -7926,8 +7775,8 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%ElemProps) ENDIF -IF (ALLOCATED(ParamData%FG_full)) THEN - DEALLOCATE(ParamData%FG_full) +IF (ALLOCATED(ParamData%FG)) THEN + DEALLOCATE(ParamData%FG) ENDIF IF (ALLOCATED(ParamData%DP0)) THEN DEALLOCATE(ParamData%DP0) @@ -7968,8 +7817,8 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%MMB)) THEN DEALLOCATE(ParamData%MMB) ENDIF -IF (ALLOCATED(ParamData%FX)) THEN - DEALLOCATE(ParamData%FX) +IF (ALLOCATED(ParamData%MBmmB)) THEN + DEALLOCATE(ParamData%MBmmB) ENDIF IF (ALLOCATED(ParamData%C1_11)) THEN DEALLOCATE(ParamData%C1_11) @@ -7977,17 +7826,11 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%C1_12)) THEN DEALLOCATE(ParamData%C1_12) ENDIF -IF (ALLOCATED(ParamData%D1_12)) THEN - DEALLOCATE(ParamData%D1_12) -ENDIF -IF (ALLOCATED(ParamData%D1_13)) THEN - DEALLOCATE(ParamData%D1_13) +IF (ALLOCATED(ParamData%D1_141)) THEN + DEALLOCATE(ParamData%D1_141) ENDIF -IF (ALLOCATED(ParamData%D1_14)) THEN - DEALLOCATE(ParamData%D1_14) -ENDIF -IF (ALLOCATED(ParamData%FY)) THEN - DEALLOCATE(ParamData%FY) +IF (ALLOCATED(ParamData%D1_142)) THEN + DEALLOCATE(ParamData%D1_142) ENDIF IF (ALLOCATED(ParamData%PhiM)) THEN DEALLOCATE(ParamData%PhiM) @@ -8007,9 +7850,6 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%D2_64)) THEN DEALLOCATE(ParamData%D2_64) ENDIF -IF (ALLOCATED(ParamData%F2_61)) THEN - DEALLOCATE(ParamData%F2_61) -ENDIF IF (ALLOCATED(ParamData%MBB)) THEN DEALLOCATE(ParamData%MBB) ENDIF @@ -8019,21 +7859,12 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%CBB)) THEN DEALLOCATE(ParamData%CBB) ENDIF -IF (ALLOCATED(ParamData%CMB)) THEN - DEALLOCATE(ParamData%CMB) -ENDIF -IF (ALLOCATED(ParamData%CBM)) THEN - DEALLOCATE(ParamData%CBM) -ENDIF IF (ALLOCATED(ParamData%CMM)) THEN DEALLOCATE(ParamData%CMM) ENDIF IF (ALLOCATED(ParamData%MBM)) THEN DEALLOCATE(ParamData%MBM) ENDIF -IF (ALLOCATED(ParamData%UL_st_g)) THEN - DEALLOCATE(ParamData%UL_st_g) -ENDIF IF (ALLOCATED(ParamData%PhiL_T)) THEN DEALLOCATE(ParamData%PhiL_T) ENDIF @@ -8100,9 +7931,6 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%ID__F)) THEN DEALLOCATE(ParamData%ID__F) ENDIF -IF (ALLOCATED(ParamData%FGL)) THEN - DEALLOCATE(ParamData%FGL) -ENDIF IF (ALLOCATED(ParamData%MoutLst)) THEN DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) CALL SD_Destroymeshauxdatatype( ParamData%MoutLst(i1), ErrStat, ErrMsg ) @@ -8204,10 +8032,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! FG_full allocated yes/no - IF ( ALLOCATED(InData%FG_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FG_full upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FG_full) ! FG_full + 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 @@ -8289,7 +8117,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! nDOFM Int_BufSz = Int_BufSz + 1 ! SttcSolve Int_BufSz = Int_BufSz + 1 ! ExtraMoment - Int_BufSz = Int_BufSz + 1 ! FixedBottom Int_BufSz = Int_BufSz + 1 ! Floating Int_BufSz = Int_BufSz + 1 ! KMMDiag allocated yes/no IF ( ALLOCATED(InData%KMMDiag) ) THEN @@ -8306,10 +8133,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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 ! 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 + 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 @@ -8321,25 +8148,15 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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_12 allocated yes/no - IF ( ALLOCATED(InData%D1_12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_12) ! D1_12 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_13 allocated yes/no - IF ( ALLOCATED(InData%D1_13) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_13 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_13) ! D1_13 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_14 allocated yes/no - IF ( ALLOCATED(InData%D1_14) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_14 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_14) ! D1_14 + 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 ! 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 + 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 @@ -8371,11 +8188,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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 ! F2_61 allocated yes/no - IF ( ALLOCATED(InData%F2_61) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F2_61 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F2_61) ! F2_61 - 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 @@ -8391,16 +8203,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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 ! CMB allocated yes/no - IF ( ALLOCATED(InData%CMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMB) ! CMB - END IF - Int_BufSz = Int_BufSz + 1 ! CBM allocated yes/no - IF ( ALLOCATED(InData%CBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CBM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBM) ! CBM - 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 @@ -8411,11 +8213,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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 ! UL_st_g allocated yes/no - IF ( ALLOCATED(InData%UL_st_g) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_st_g upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_st_g) ! UL_st_g - 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 @@ -8541,11 +8338,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si 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 ! FGL allocated yes/no - IF ( ALLOCATED(InData%FGL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FGL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FGL) ! FGL END IF Int_BufSz = Int_BufSz + 1 ! NMOutputs Int_BufSz = Int_BufSz + 1 ! NumOuts @@ -8763,18 +8555,18 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%FG_full) ) THEN + 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_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG_full,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_full,1), UBOUND(InData%FG_full,1) - DbKiBuf(Db_Xferred) = InData%FG_full(i1) + 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 @@ -8988,8 +8780,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%ExtraMoment, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedBottom, 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 @@ -9042,19 +8832,24 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%FX) ) THEN + 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%FX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,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 i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) - ReKiBuf(Re_Xferred) = InData%FX(i1) - Re_Xferred = Re_Xferred + 1 + 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 @@ -9097,81 +8892,46 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%D1_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%D1_12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_12,2), UBOUND(InData%D1_12,2) - DO i1 = LBOUND(InData%D1_12,1), UBOUND(InData%D1_12,1) - ReKiBuf(Re_Xferred) = InData%D1_12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_13) ) THEN + 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_13,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_13,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_13,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_13,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_13,2), UBOUND(InData%D1_13,2) - DO i1 = LBOUND(InData%D1_13,1), UBOUND(InData%D1_13,1) - ReKiBuf(Re_Xferred) = InData%D1_13(i1,i2) + 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_14) ) THEN + 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_14,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_14,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_14,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_14,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_14,2), UBOUND(InData%D1_14,2) - DO i1 = LBOUND(InData%D1_14,1), UBOUND(InData%D1_14,1) - ReKiBuf(Re_Xferred) = InData%D1_14(i1,i2) + 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%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%PhiM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9292,21 +9052,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%F2_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%F2_61,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F2_61,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F2_61,1), UBOUND(InData%F2_61,1) - ReKiBuf(Re_Xferred) = InData%F2_61(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF IF ( .NOT. ALLOCATED(InData%MBB) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9367,46 +9112,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%CMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMB,2), UBOUND(InData%CMB,2) - DO i1 = LBOUND(InData%CMB,1), UBOUND(InData%CMB,1) - ReKiBuf(Re_Xferred) = InData%CMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CBM,2), UBOUND(InData%CBM,2) - DO i1 = LBOUND(InData%CBM,1), UBOUND(InData%CBM,1) - ReKiBuf(Re_Xferred) = InData%CBM(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 @@ -9447,21 +9152,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%UL_st_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%UL_st_g,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_st_g,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_st_g,1), UBOUND(InData%UL_st_g,1) - ReKiBuf(Re_Xferred) = InData%UL_st_g(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9868,21 +9558,6 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf(Int_Xferred) = InData%ID__F(i1) Int_Xferred = Int_Xferred + 1 END DO - END IF - IF ( .NOT. ALLOCATED(InData%FGL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FGL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FGL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FGL,1), UBOUND(InData%FGL,1) - ReKiBuf(Re_Xferred) = InData%FGL(i1) - Re_Xferred = Re_Xferred + 1 - END DO END IF IntKiBuf(Int_Xferred) = InData%NMOutputs Int_Xferred = Int_Xferred + 1 @@ -10242,21 +9917,21 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG_full not allocated + 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_full)) DEALLOCATE(OutData%FG_full) - ALLOCATE(OutData%FG_full(i1_l:i1_u),STAT=ErrStat2) + 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_full.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%FG_full,1), UBOUND(OutData%FG_full,1) - OutData%FG_full(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + 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 @@ -10518,8 +10193,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 OutData%ExtraMoment = TRANSFER(IntKiBuf(Int_Xferred), OutData%ExtraMoment) Int_Xferred = Int_Xferred + 1 - OutData%FixedBottom = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedBottom) - 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 @@ -10581,22 +10254,27 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX not allocated + 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 - IF (ALLOCATED(OutData%FX)) DEALLOCATE(OutData%FX) - ALLOCATE(OutData%FX(i1_l:i1_u),STAT=ErrStat2) + 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%FX.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', 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 + 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 @@ -10645,7 +10323,7 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_12 not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_141 not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -10655,20 +10333,20 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_12)) DEALLOCATE(OutData%D1_12) - ALLOCATE(OutData%D1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + 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_12.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%D1_12,2), UBOUND(OutData%D1_12,2) - DO i1 = LBOUND(OutData%D1_12,1), UBOUND(OutData%D1_12,1) - OutData%D1_12(i1,i2) = ReKiBuf(Re_Xferred) + 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_13 not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_142 not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -10678,60 +10356,19 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_13)) DEALLOCATE(OutData%D1_13) - ALLOCATE(OutData%D1_13(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + 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_13.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%D1_13,2), UBOUND(OutData%D1_13,2) - DO i1 = LBOUND(OutData%D1_13,1), UBOUND(OutData%D1_13,1) - OutData%D1_13(i1,i2) = ReKiBuf(Re_Xferred) + 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 ! D1_14 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - 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_14)) DEALLOCATE(OutData%D1_14) - ALLOCATE(OutData%D1_14(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_14.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_14,2), UBOUND(OutData%D1_14,2) - DO i1 = LBOUND(OutData%D1_14,1), UBOUND(OutData%D1_14,1) - OutData%D1_14(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 ! PhiM not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10870,24 +10507,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F2_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 - IF (ALLOCATED(OutData%F2_61)) DEALLOCATE(OutData%F2_61) - ALLOCATE(OutData%F2_61(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F2_61,1), UBOUND(OutData%F2_61,1) - OutData%F2_61(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10957,52 +10576,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMB)) DEALLOCATE(OutData%CMB) - ALLOCATE(OutData%CMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMB,2), UBOUND(OutData%CMB,2) - DO i1 = LBOUND(OutData%CMB,1), UBOUND(OutData%CMB,1) - OutData%CMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CBM)) DEALLOCATE(OutData%CBM) - ALLOCATE(OutData%CBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CBM,2), UBOUND(OutData%CBM,2) - DO i1 = LBOUND(OutData%CBM,1), UBOUND(OutData%CBM,1) - OutData%CBM(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 @@ -11049,24 +10622,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_st_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 - IF (ALLOCATED(OutData%UL_st_g)) DEALLOCATE(OutData%UL_st_g) - ALLOCATE(OutData%UL_st_g(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_st_g.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_st_g,1), UBOUND(OutData%UL_st_g,1) - OutData%UL_st_g(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -11539,24 +11094,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%ID__F(i1) = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FGL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FGL)) DEALLOCATE(OutData%FGL) - ALLOCATE(OutData%FGL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FGL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FGL,1), UBOUND(OutData%FGL,1) - OutData%FGL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF OutData%NMOutputs = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1